如何快速合并多个相同格式的工作簿数据到新的工作簿

xxp_dff

请教各位大神！如何快速合并多个相同格式的工作簿数据到新的汇总工作簿，详见附件，用函数或VBA。

朝露孤烟

函数方法。需要源表都打开。数据区域按实际调整。

朝露孤烟

供参考的附件。

沈默00

=LET(a,[甲公司.xlsx]销量!$A$2:.$B$99,b,[乙公司.xlsx]销量!$A$2:.$B$99,s,VSTACK(HSTACK(REPTARRAY({"甲公司"},ROWS(a)),a),HSTACK(REPTARRAY({"乙公司"},ROWS(b)),b)),PIVOTBY(CHOOSECOLS(s,2),TAKE(s,,1),TAKE(s,,-1),SUM,,1,,0))
收入是同样的写法

沈默00

应该不止两个表吧，，多了建议用VBA，，

gwjkkkkk

Option Explicit
Sub test()
    Dim ar(), br, vResult, i&, j&, r&, c&, strFileName$, strPath$
    Dim iPosRow&, dic As Object, strKey$
   
    Application.ScreenUpdating = False
   
    strPath = ThisWorkbook.Path & "\"
    strFileName = Dir(strPath & "*.xls")
    Do Until strFileName = ""
        If strFileName <> ThisWorkbook.Name Then
            With GetObject(strPath & strFileName)
                r = r + 1
                ReDim Preserve ar(1 To 2, 1 To r)
                ar(1, r) = Left(strFileName, InStrRev(strFileName, ".") - 1)
                ar(2, r) = .Worksheets(1).[A1].CurrentRegion.Value
                .Close False
            End With
        End If
        strFileName = Dir
    Loop
   
    Set dic = CreateObject("Scripting.Dictionary")
    ReDim vResult(1 To 10 ^ 4, 1 To UBound(ar, 2) + 1)
    vResult(1, 1) = "产品": r = 1: c = 1
    ReDim br(1 To UBound(ar, 2) + 1): br(1) = "合计"
   
    For j = 1 To UBound(ar, 2)
        c = c + 1: vResult(1, c) = ar(1, j)
        For i = 2 To UBound(ar(2, j))
            strKey = ar(2, j)(i, 1)
            If Not dic.exists(strKey) Then
                r = r + 1
                vResult(r, 1) = strKey
                dic(strKey) = r
            End If
            iPosRow = dic(strKey)
            vResult(iPosRow, c) = vResult(iPosRow, c) + ar(2, j)(i, 2)
            br(c) = br(c) + ar(2, j)(i, 2)
        Next i
    Next j
   
    r = r + 1
    For j = 1 To UBound(br)
        vResult(r, j) = br(j)
    Next j
   
    [F1].Resize(r, UBound(vResult, 2)) = vResult
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

vba法参与一下。。。

xxp_dff

谢谢以上各位大神！

xxp_dff

gwjkkkkk 发表于 2025-7-6 10:34
Option Explicit
Sub test()
    Dim ar(), br, vResult, i&, j&, r&, c&, strFileName$, strPath$

请教这个代码如何植入EXCEL中，我是小白，不是很懂。谢谢！

xxp_dff

朝露孤烟 发表于 2025-7-5 23:41
函数方法。需要源表都打开。数据区域按实际调整。

可惜我的OFFICE2021没有GROUBY这个函数