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