求助！！！！多表不同表头怎么合并啊？？拜托了

yy1506697381

求助！！！！多表不同表头怎么合并啊？？拜托了

yy1506697381

求助各位大神了，如何把这三个工作簿里的三个工作表合并成新的一张表啊VBA，拜托了（需要普适性，换个表头还能用的））

zpy2

yy1506697381 发表于 2022-2-9 22:55
求助各位大神了，如何把这三个工作簿里的三个工作表合并成新的一张表啊VBA，拜托了（需要普适性，换个表头 ...

一定要要vba?

yy1506697381

是呀，因为想做成普适性

zpy2

yy1506697381 发表于 2022-2-10 10:34
是呀，因为想做成普适性

普适性？跨平台？
vba不能在手机上运行吧！
不过vba的确是比较方便在excel环境运行的。

yy1506697381

Sub ComData()
    Dim sPath As String
    '选择文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            sPath = .SelectedItems(1)
            sPath = sPath & IIf(VBA.Right(sPath, 1) = "\", "", "\")
        Else
            End
        End If
    End With
   
    Dim file As String, ShtCount As Long
    Dim dTitle As Object, dData As Object
    Dim Sht As Worksheet, wb As Workbook
    file = Dir(sPath & "*.xl*")
    Set dTitle = CreateObject("Scripting.dictionary")
    Set dData = CreateObject("Scripting.dictionary")
   
    Dim ShtName As String, wbName As String
   
    t = Timer
    '标题和数据分别装入字典备用
    Application.ScreenUpdating = False
    Do While Len(file) > 0
        Set wb = Workbooks.Open(sPath & file, False, True)
        For Each Sht In wb.Worksheets
            ShtCount = ShtCount + 1
            arr = Sht.Range("A1").CurrentRegion.Value
            ShtName = Sht.Name '工作表名称
            wbName = Split(wb.Name, ".")(0) '文件名
            dData(wbName & "|" & ShtName) = arr
            For i = 1 To UBound(arr, 2)
                If Not dTitle.exists(arr(1, i)) Then
                   k = k + 1
                   dTitle(arr(1, i)) = k
                End If
            Next
        Next
        
        wb.Close 0
        file = Dir
    Loop
    Application.ScreenUpdating = True
   
    Dim brr()
    '+2 文件名+表名
    ReDim brr(1 To 100000, 1 To dTitle.Count + 2)
   
    For Each eve In dData.keys()
        arr = dData(eve)
        For i = 2 To UBound(arr)
            n = n + 1
            tp = Split(eve, "|")
            brr(n, 1) = tp(0) '文件名
            brr(n, 2) = tp(1) '表名
            For j = 1 To UBound(arr, 2)
                brr(n, dTitle(arr(1, j)) + 2) = arr(i, j)
            Next
        Next
    Next
   
    '写入汇总表，没有的自己建一个
    With Sheets("汇总表")
        .Cells.Clear
        .Range("A1:B1") = Array("文件名", "表名")
        .Range("C1").Resize(1, dTitle.Count) = dTitle.keys()
        .Range("A2").Resize(n, dTitle.Count + 2) = brr
    End With
   
    MsgBox "汇总完成！共汇总：" & ShtCount & "个表！" _
    & vbCrLf & "用时:" & Format(Timer - t, "0.00s")
End Sub

yy1506697381

能否请大神帮我改一下代码，从第三行开始取数呀，这个代码是从第一行开始取的

yy1506697381

yy1506697381 发表于 2022-2-11 11:24
能否请大神帮我改一下代码，从第三行开始取数呀，这个代码是从第一行开始取的

想以第三行为表头