|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub lqxs()
- Dim Arr, myPath$, myName$, Arr1, j&, d, i&
- Set d = CreateObject("Scripting.Dictionary")
- Application.ScreenUpdating = False
- Sheet1.Activate
- myPath = ThisWorkbook.Path & ""
- myName = Dir(myPath & "*.xlsx")
- Do While myName <> ""
- If InStr(myName, "汇总") = 0 Then
- With GetObject(myPath & myName)
- Arr1 = .Sheets(1).Range("A1:AJ5")
- For j = 2 To UBound(Arr1, 2) Step 7
- If Arr1(3, j) <> "" Then d(Arr1(3, j)) = Arr1(5, j)
- Next
- .Close False
- End With
- End If
- myName = Dir
- Loop
- Arr = [a1].CurrentRegion
- For i = 3 To UBound(Arr)
- If d.exists(Arr(i, 1)) Then Cells(i, 2) = d(Arr(i, 1))
- Next
- Application.ScreenUpdating = True
- End Sub
- 是Arr1,前面的帖子出错了。
复制代码 |
|