如何通过相同类别的表格，进行多表格合并

零·yy

如何通过相同类的表格，进行多表格合并，请大佬帮帮忙，先在此谢谢了

良良

易用宝合并，请看附件：

HSIAOQIANG

INDIRECT函數

3190496160

Sub 合并()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Dim br()
ReDim br(1 To 50000, 1 To 2)
f = Dir(ThisWorkbook.Path & "\*.xls*")
Do While f <> ""
    If f <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
        With wb.Worksheets(1)
            rs = .Cells(Rows.Count, 1).End(xlUp).Row
            ar = .Range("a1:b" & rs)
        End With
        wb.Close False
        For i = 2 To UBound(ar)
            If Trim(ar(i, 1)) <> "" And Trim(ar(i, 2)) <> "" Then
                t = d(Trim(ar(i, 1)))
                If t = "" Then
                    k = k + 1
                    d(Trim(ar(i, 1))) = k
                    t = k
                    br(k, 1) = ar(i, 1)
                End If
                br(t, 2) = br(t, 2) + ar(i, 2)
            End If
        Next i
    End If
f = Dir
Loop
With Sheet1
    .[a1].CurrentRegion.Offset(1).Clear
    .[a2].Resize(k, 2) = br
    .[a2].Resize(k, 2).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

多表格合并求助.rar (54.66 KB, 下载次数: 4)

2022-11-24 13:02 上传

点击文件名下载附件

minchar

如果是OFFICE用PQ

零·yy

3190496160 发表于 2022-11-24 13:01
Sub 合并()
Application.ScreenUpdating = False
Dim ar As Variant

高手，你好，再想问一下要是用在其他的表格，怎么修改呀

3190496160

零·yy 发表于 2022-11-25 08:49
高手，你好，再想问一下要是用在其他的表格，怎么修改呀

如果是表格结构一致，需求一样，是不需要修改代码的呀