|
楼主 |
发表于 2019-1-19 13:01
|
显示全部楼层
Sub dsmch()
Dim arr, brr, d, w, i&, s&, j%
w = Array("钻", "金", "银", "铜")
Set d = CreateObject("scripting.dictionary")
ReDim brr(1 To 20000, 1 To 12)
Range("a2:l20000").ClearContents
mypath = ThisWorkbook.Path & "\"
wj = Dir(mypath & "*.xls*")
Do While wj <> ""
If wj <> ThisWorkbook.Name Then
With GetObject(mypath & wj)
arr = .Sheets(1).Range("a1").CurrentRegion
.Close 0
End With
For i = 2 To UBound(arr)
arr(i, 1) = "'" & arr(i, 1)
If Not d.exists(arr(i, 11)) Then
d(arr(i, 11)) = ""
Set d(arr(i, 11)) = CreateObject("scripting.dictionary")
End If
If Not d(arr(i, 11)).exists(arr(i, 1)) Then d(arr(i, 11))(arr(i, 1)) = i
Next
For i = 0 To UBound(w)
For Each b In d(w(i)).items
If Not d.exists(arr(b, 1)) Then
d(arr(b, 1)) = ""
s = s + 1
For j = 1 To UBound(arr, 2)
brr(s, j) = arr(b, j)
Next
End If
Next
Next
End If
wj = Dir
Loop
Range("a2").Resize(s, UBound(brr, 2)) = brr
End Sub
放入了以上的代码,然后文档里面有7个excel文档,运行代码是出现“运行时错误9 下标越界 ” 的提示,请问是缺了什么吗 |
|