[已解决]提取外部文档，我想修改两个地方

lhj323323 · 发表于 2016-6-11 18:41

老师：

上传的附件，能实现提取同路径的指定后缀的所有文档。

但是，我需要修改两个地方的错误，搞了一下午，都没有成功，详细的说明，请看附件。先谢谢了

求助.rar (30.85 KB, 下载次数: 16)

老司机带带我 · 发表于 2016-6-11 19:40

把修改前的代码改一下：

Sub 导入()
Dim MyPath, MyName, wk As Workbook, Sht As Worksheet, m As Integer, arr, n As Integer, u As Integer
Application.ScreenUpdating = False
MyPath = ThisWorkbook.Path
MyName = Dir(MyPath & "" & "*.xls")
m = 0: n = 0 'MsgBox
Do While MyName <> ""
If MyName <> ThisWorkbook.Name Then
Set wk = Workbooks.Open(MyPath & "" & MyName)
m = m + 1 'MsgBox
For Each Sht In wk.Sheets
arr = Sht.UsedRange
If IsArray(arr) = False Then GoTo PP
n = n + 1
With ThisWorkbook.Sheets("数据源")
u = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A" & u).Resize(UBound(arr), UBound(arr, 2)) = arr
End With
Erase arr '释放数组
PP:
Next
wk.Close False
End If
MyName = Dir
Loop
With Sheet2
.Activate
End With
Application.EnableEvents = True
End Sub

复制代码

lhj323323 · 发表于 2016-6-11 19:46

老司机带带我发表于 2016-6-11 19:40
把修改前的代码改一下：

谢谢老师的回复

还是有问题
修改前的按纽，生成421行数据，扣除第1行空行，实应有420行
而按您所写的语句，生成了414行数据，

数据缺失了。

而且，MYNAME变量并没有修改。

老司机带带我 · 发表于 2016-6-11 20:04

加个判断吧

Sub 导入()
Dim MyPath, MyName, wk As Workbook, Sht As Worksheet, m As Integer, arr, n As Integer, u As Integer, x&
Application.ScreenUpdating = False
MyPath = ThisWorkbook.Path
MyName = Dir(MyPath & "" & "*.xls")
m = 0: n = 0 'MsgBox
Do While MyName <> ""
If MyName <> ThisWorkbook.Name Then
Set wk = Workbooks.Open(MyPath & "" & MyName)
m = m + 1 'MsgBox
For Each Sht In wk.Sheets
arr = Sht.UsedRange
If IsArray(arr) = False Then GoTo PP
n = n + 1
With ThisWorkbook.Sheets("数据源")
x = x + 1
u = .Cells(.Rows.Count, 1).End(xlUp).Row
If x = 1 Then
.Range("A1").Resize(UBound(arr), UBound(arr, 2)) = arr
MsgBox "xx"
Else
.Range("A" & u + 1).Resize(UBound(arr), UBound(arr, 2)) = arr
End If
'u = .UsedRange.Row + .UsedRange.Rows.Count
'.Range("A" & u).Resize(UBound(arr), UBound(arr, 2)) = arr
End With
Erase arr '释放数组
PP:
Next
wk.Close False
End If
MyName = Dir
Loop
With Sheet2
.Activate
End With
Application.EnableEvents = True
End Sub

复制代码

lhj323323 · 发表于 2016-6-11 23:26

老司机带带我发表于 2016-6-11 20:04
加个判断吧

老师：
MyName = Dir(MyPath & "\" & "*.xls")
MyName如要定义为"*.xls"，我的原语句将怎么改？

老司机带带我 · 发表于 2016-6-12 08:24

lhj323323 发表于 2016-6-11 23:26
老师：
MyName = Dir(MyPath & "\" & "*.xls")
MyName如要定义为"*.xls"，我的原语句将怎么改？

MyName如要定义为"*.xls"有什么意义？方便文件类型修改？你附件里面的修改后代码是明显错误的！

lhj323323 · 发表于 2016-6-12 10:21

老司机带带我发表于 2016-6-12 08:24
MyName如要定义为"*.xls"有什么意义？方便文件类型修改？你附件里面的修改后代码是明显错误的！

老师：

正因为修改后，是错误的，才进行求助的啊
空一行的问题都可以先放一放

修改前的，虽然能提取数据，但语句的逻辑性是错误的。
仍是MYNAME这一句就开始出现逻辑错误，所以，才有[修改后]这一做法。
结果没想到，还不能修改透彻。

老司机带带我 · 发表于 2016-6-12 10:38

lhj323323 发表于 2016-6-12 10:21
老师：

正因为修改后，是错误的，才进行求助的啊

修改后的代码中你把Myname的初始值设置为“*.xls”，而“*.xls”实际并不是文件名，当你执行DO循环的第一次循环时Set wk = Workbooks.Open(MyPath & "\" & MyName)这句时就会发生错误了，因为MyPath & "\" & MyName并非有效文件；
而通过MyName = Dir(MyPath & "\" & "*.xls")会获得相应路径，相应类型的文件名称，MyName返回的是文件名，这样Set wk = Workbooks.Open(MyPath & "\" & MyName)才有效！

你指的逻辑错误我不知道是指的哪个，修改前的错误除了空一行，其它问题在哪，我再帮你看下！

lhj323323 · 发表于 2016-6-12 15:04

本帖最后由 lhj323323 于 2016-6-12 15:09 编辑

老司机带带我发表于 2016-6-12 10:38
修改后的代码中你把Myname的初始值设置为“*.xls”，而“*.xls”实际并不是文件名，当你执行DO循环的第一 ...

谢谢老师这么耐心的解答

下面附一个我曾经收集的一个语句
它是从指定路径提取提定文档，并导入到模板的sheet2工作表中
由于是提取的单一指定文档，所以没有采取循环的方式
我一直觉得这个版主所写的MYNAME在逻辑上更讲得服人，但是因为我的知识水平太差，也就老是植入不了。

Sub 导入xls1() 'www.officefans.net论坛的wxyqxxz2007版主
Dim MyPath, MyName, wk As Workbook, Sht As Worksheet, arr
Application.ScreenUpdating = False
MyPath = ThisWorkbook.Path
MyName = "J.xls"
With ThisWorkbook
      Sheet2.Cells.Clear
      If Dir(MyPath & "\" & MyName) <> "" Then
         Set wk = Workbooks.Open(MyPath & "\" & MyName)
         For Each Sht In wk.Sheets
            arr = Sht.UsedRange
            If IsArray(arr) = False Then GoTo PP
            With .Sheets("ID_1")
                  '.Cells.Clear
                  .Cells(1, 1).Resize(UBound(arr), UBound(arr, 2)) = arr
                  .Rows.Font.Name = "宋体"
                  .Rows.Font.Size = 10
                  .Columns.AutoFit
               End With
               Erase arr
PP:
         Next
         wk.Close False
      Else
         MsgBox "没有找到该文件"
      End If
End With
Application.EnableEvents = True
Sheet2.Activate
End Sub

我只是想套用它的语句，由提取单一文档，变成提取N个文档，这个N，有时候，也可能是1。我需要它进行循环，
也就是说，我需要把两种写法融合到一起。
即，我修前改的语句和这个版主的关于MYNAME的表达式，融合在一起。制成一种通用的工具

老司机带带我 · 发表于 2016-6-12 15:08

本帖最后由老司机带带我于 2016-6-12 15:10 编辑

lhj323323 发表于 2016-6-12 15:04
谢谢老师这么耐心的解答

下面附一个我曾经收集的一个语句

这段代码只提取了J.xls这一工作簿的数据，你是要提取所有工作簿的数据，完全不一样，如果只提取单个工作簿信息，也完全用不上Dir吧！

如果要融合，就是吧J改成*，然后if语句改成循环语句就遍历了！

		自动登录	找回密码
密码			注册