Excel文件格式壹致，匯總求和，其他需求自行變通容
匯總使用了字典
Public d
Sub 按鈕1_Click()
Application.ScreenUpdating = False
ActiveSheet.UsedRange.ClearContents
Cells(1, 1) = "編號"
Cells(1, 2) = "數量"
Set d = CreateObject("scripting.dictionary")
Getfd (ThisWorkbook.Path) 'ThisWorkbook.Path是當前代碼文件所在路徑，路徑名可以根據需求修改
Application.ScreenUpdating = True
If d.Count > 0 Then
ThisWorkbook.Sheets(1).[a2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
ThisWorkbook.Sheets(1).[b2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)
End If
End Sub
Sub Getfd(ByVal pth)
Set Fso = CreateObject("scripting.filesystemobject")
Set ff = Fso.getfolder(pth)
For Each f In ff.Files
Rem 具體提取哪類文件，還是需要根據文件擴展名進行處理
If InStr(Split(f.Name, ".")(UBound(Split(f.Name, "."))), "xl") > 0 Then
If f.Name <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(f)
For Each sht In wb.Sheets
If WorksheetFunction.CountA(sht.UsedRange) > 1 Then
arr = sht.UsedRange
For j = 2 To UBound(arr)
d(arr(j, 1)) = d(arr(j, 1)) + arr(j, 2)
Next j
End If
Next sht
wb.Close False
End If
End If
Next f
For Each fd In ff.subfolders
Getfd (fd)
Next fd
End Sub