|
小弟做了个遍历文件夹取数的SUB,第一个文件取数很正常,到打开第二个文件的时候字典就出错了,不知道什么原因,请大家帮忙一下。
Sub HuiZong()
Dim myfile, mypath, wb '声明变量
Dim d As Object
Dim arr As Variant
Dim p, r, m As Integer
'On Error Resume Next '// 发生错误,自动执行下一句,就是忽略错误
Application.ScreenUpdating = False '//关闭屏幕刷新
Application.DisplayAlerts = False '//关闭系统提示
Worksheets("对账单台账").Range("A2:H65536").Clear '清除除表头之外的所有内容
mypath = ThisWorkbook.Path '找到当前工作簿的路径
myfile = Dir(mypath & "\*.xls*") '遍历当前文件夹下的Excel文件
Set d = CreateObject("scripting.dictionary") '定义字典
p = 2
Do While myfile <> "" '当找到的文件不为空时
If myfile <> ThisWorkbook.Name Then '当找到的文件不是当前Excel工作簿时
Set wb = GetObject(mypath & "\" & myfile) '得到dir找到的工作簿的内容,设为wb
If wb.Name Like "DZ" & "*" Then
With wb.Worksheets("page1") '对找到的工作簿的sheet1进行操作
Worksheets("对账单台账").Cells(p, 1).Value = .Cells(4, 2).Value
Worksheets("对账单台账").Cells(p, 2).Value = .Cells(6, 2).Value
Worksheets("对账单台账").Cells(p, 3).Value = .Cells(8, 2).Value
Worksheets("对账单台账").Cells(p, 4).Value = .Cells(4, 10).Value
Worksheets("对账单台账").Cells(p, 5).Value = .Cells(6, 10).Value
Worksheets("对账单台账").Cells(p, 6).Value = .Cells(8, 10).Value
Worksheets("对账单台账").Cells(p, 7).Value = .Cells(10, 10).Value
r = wb.Worksheets("page1").Range("a65536").End(xlUp).Row - 3
arr = .Range("c13:c" & r)
For i = 1 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + 1 ‘到这里就出错了’
Next
k = d.keys
x = k(0)
For m = 1 To UBound(k)
x = x & "\" & k(m)
Next
Worksheets("对账单台账").Cells(p, 8).Value = x
p = p + 1
End With
End If
wb.Close False '关闭wb工作簿且不保存
d.RemoveAll
Set d = Nothing
End If
myfile = Dir '寻找下一个Excel工作簿
Loop
Application.ScreenUpdating = True '恢复屏幕更新
End Sub
|
-
提示错误
-
字典语句中断
|