|
参与一下。。。
- Sub ykcbf() '//2024.4.10
- Set fso = CreateObject("scripting.filesystemobject")
- Set d = CreateObject("Scripting.Dictionary")
- Application.ScreenUpdating = False
- Set sh = ThisWorkbook.Sheets("2024")
- p = ThisWorkbook.Path & "\购物"
- For Each f In fso.GetFolder(p).Files
- If f.Name Like "*.xls*" Then
- If InStr(f.Name, ThisWorkbook.Name) = 0 Then
- fn = fso.GetBaseName(f)
- Set wb = Workbooks.Open(f, 0)
- With wb.Sheets("2024")
- arr = .UsedRange
- wb.Close False
- End With
- For i = 4 To 7
- s = CStr(arr(i, 1))
- d(s) = d(s) + arr(i, 4)
- Next
- End If
- End If
- Next f
- With sh
- For i = 4 To 7
- s = CStr(.Cells(i, 1))
- .Cells(i, 4) = d(s)
- Next
- End With
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|
评分
-
1
查看全部评分
-
|