Excel-合并具有不同结构的工作表

我有一个Excel工作簿，其中有100多个工作表，所有这些工作表都有不同的结构（有些列在所有这些工作表中，但有些不是）。有没有一种简单的方法可以根据工作表的公共列合并工作表

提前谢谢你

执行以下操作：

• 打开VBA编辑器窗口
• 从文件菜单中单击“工具”
• 从“工具”菜单中选择“参考”
• 向下滚动，直到找到“Microsoft脚本运行时”
• 选中“Microsoft脚本运行时”旁边的框
• 单击“确定”

然后将其粘贴到Excel vba模块中：

    Option Explicit
    Public Sub CombineSheetsWithDifferentHeaders()

        Dim wksDst As Worksheet, wksSrc As Worksheet
        Dim lngIdx As Long, lngLastSrcColNum As Long, _
            lngFinalHeadersCounter As Long, lngFinalHeadersSize As Long, _
            lngLastSrcRowNum As Long, lngLastDstRowNum As Long
        Dim strColHeader As String
        Dim varColHeader As Variant
        Dim rngDst As Range, rngSrc As Range
        Dim dicFinalHeaders As Scripting.Dictionary
        Set dicFinalHeaders = New Scripting.Dictionary

        'Set references up-front
        dicFinalHeaders.CompareMode = vbTextCompare
        lngFinalHeadersCounter = 1
        lngFinalHeadersSize = dicFinalHeaders.Count
        Set wksDst = ThisWorkbook.Worksheets.Add

        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'Start Phase 1: Prepare Final Headers and Destination worksheet'
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        'First, we loop through all of the data worksheets,
        'building our Final Headers dictionary
        For Each wksSrc In ThisWorkbook.Worksheets

            'Make sure we skip the Destination worksheet!
            If wksSrc.Name <> wksDst.Name Then

                With wksSrc

                    'Loop through all of the headers on this sheet,
                    'adding them to the Final Headers dictionary
                    lngLastSrcColNum = LastOccupiedColNum(wksSrc)
                    For lngIdx = 1 To lngLastSrcColNum

                        'If this column header does NOT already exist in the Final
                        'Headers dictionary, add it and increment the column number
                        strColHeader = Trim(CStr(.Cells(1, lngIdx)))
                        If Not dicFinalHeaders.Exists(strColHeader) Then
                            dicFinalHeaders.Add Key:=strColHeader, _
                                                Item:=lngFinalHeadersCounter
                            lngFinalHeadersCounter = lngFinalHeadersCounter + 1
                        End If

                    Next lngIdx

                End With

            End If

        Next wksSrc

        'Wahoo! The Final Headers dictionary now contains every column
        'header name from the worksheets. Let's write these values into
        'the Destination worksheet and finish Phase 1
        For Each varColHeader In dicFinalHeaders.Keys
            wksDst.Cells(1, dicFinalHeaders(varColHeader)) = CStr(varColHeader)
        Next varColHeader

        '''''''''''''''''''''''''''''''''''''''''''''''
        'End Phase 1: Final Headers are ready to rock!'
        '''''''''''''''''''''''''''''''''''''''''''''''

        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        'Start Phase 2: write the data from each worksheet to the Destination!'
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

        'We begin just like Phase 1 -- by looping through each sheet
        For Each wksSrc In ThisWorkbook.Worksheets

            'Once again, make sure we skip the Destination worksheet!
            If wksSrc.Name <> wksDst.Name Then

                With wksSrc

                    'Identify the last row and column on this sheet
                    'so we know when to stop looping through the data
                    lngLastSrcRowNum = LastOccupiedRowNum(wksSrc)
                    lngLastSrcColNum = LastOccupiedColNum(wksSrc)

                    'Identify the last row of the Destination sheet
                    'so we know where to (eventually) paste the data
                    lngLastDstRowNum = LastOccupiedRowNum(wksDst)

                    'Loop through the headers on this sheet, looking up
                    'the appropriate Destination column from the Final
                    'Headers dictionary and creating ranges on the fly
                    For lngIdx = 1 To lngLastSrcColNum
                        strColHeader = Trim(CStr(.Cells(1, lngIdx)))

                        'Set the Destination target range using the
                        'looked up value from the Final Headers dictionary
                        Set rngDst = wksDst.Cells(lngLastDstRowNum + 1, _
                                                  dicFinalHeaders(strColHeader))

                        'Set the source target range using the current
                        'column number and the last-occupied row
                        Set rngSrc = .Range(.Cells(2, lngIdx), _
                                            .Cells(lngLastSrcRowNum, lngIdx))

                        'Copy the data from this sheet to the destination!
                        rngSrc.Copy Destination:=rngDst

                    Next lngIdx

                End With

            End If

        Next wksSrc

        'Yay! Let the user know that the data has been combined
        MsgBox "Data combined!"

    End Sub

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'INPUT       : Sheet, the worksheet we'll search to find the last row
    'OUTPUT      : Long, the last occupied row
    'SPECIAL CASE: if Sheet is empty, return 1
    Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
        Dim lng As Long
        If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
            With Sheet
                lng = .Cells.Find(What:="*", _
                                  After:=.Range("A1"), _
                                  Lookat:=xlPart, _
                                  LookIn:=xlFormulas, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlPrevious, _
                                  MatchCase:=False).Row
            End With
        Else
            lng = 1
        End If
        LastOccupiedRowNum = lng
    End Function

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'INPUT       : Sheet, the worksheet we'll search to find the last column
    'OUTPUT      : Long, the last occupied column
    'SPECIAL CASE: if Sheet is empty, return 1
    Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
        Dim lng As Long
        If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
            With Sheet
                lng = .Cells.Find(What:="*", _
                                  After:=.Range("A1"), _
                                  Lookat:=xlPart, _
                                  LookIn:=xlFormulas, _
                                  SearchOrder:=xlByColumns, _
                                  SearchDirection:=xlPrevious, _
                                  MatchCase:=False).Column
            End With
        Else
            lng = 1
        End If
        LastOccupiedColNum = lng
    End Function

选项显式
具有不同命令的公共子组合请求（）
Dim wksDst作为工作表，WKSRC作为工作表
Dim lngIdx为长，lngLastSrcColNum为长_
LNGfinalHeaders计数器长度，LNGfinalHeaders大小长度_
Lnglastscrownum等长，Lnglastscrownum等长
作为字符串的Dim STRCOLLHEADER
Dim varColHeader作为变型
变暗rngDst As范围，rngSrc As范围
Dim DicFinalHeader作为脚本。字典
Set dicFinalHeaders=New Scripting.Dictionary
“在前面设置引用
dicFinalHeaders.CompareMode=vbTextCompare
lngFinalHeadersCounter=1
lngFinalHeadersSize=dicFinalHeaders.Count
设置wksDst=thiswoolk.Worksheets.Add
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'开始阶段1：准备最终标题和目标工作表'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
首先，我们循环浏览所有的数据工作表，
“构建我们的最终标题词典
对于此工作簿中的每个WKSRC。工作表
'确保跳过目标工作表！
如果wksrc.Name wksDst.Name，则
与WKSRC合作
'循环浏览此工作表上的所有标题，
'将它们添加到最终标题词典中
Lnglaststrccolnum=最近占用的Lnum（WKSRC）
对于LNGIX=1到lngLastSrcColNum
'如果此列标题在最终版本中不存在
'标题字典，添加它并增加列号
strColHeader=Trim（CStr（.Cells（1，lngIdx）））
如果不存在dicFinalHeaders.Exists（strColHeader），则
dicFinalHeaders.Add键：=strColHeader_
项目：=lngFinalHeadersCounter
lngFinalHeadersCounter=lngFinalHeadersCounter+1
如果结束
下一个lngIdx
以
如果结束
下一届西九龙文娱艺术中心
“哇！最终的标题字典现在包含每一列
'工作表中的标题名称。让我们将这些值写入
'目标工作表并完成阶段1
对于dicFinalHeaders.key中的每个varColHeader
WKSST.单元格（1，双最终标题（varColHeader））=CStr（varColHeader）
下一个varColHeader
'''''''''''''''''''''''''''''''''''''''''''''''
'第1阶段结束：最终收割台已准备好摇摆！'
'''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'开始阶段2：将每个工作表中的数据写入目标！'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
“我们开始时就像第一阶段一样——在每张纸上循环
对于此工作簿中的每个WKSRC。工作表
'再次确保跳过目标工作表！
如果wksrc.Name wksDst.Name，则
与WKSRC合作
'标识此工作表上的最后一行和最后一列
所以我们知道什么时候停止循环数据
lngLastSrcRowNum=LastoccupieTowneum（WKSRC）
Lnglaststrccolnum=最近占用的Lnum（WKSRC）
'标识目标工作表的最后一行
因此我们知道（最终）将数据粘贴到哪里
lngLastDstRowNum=最后发生率（wksDst）
'循环浏览此工作表上的标题，向上查找
'从最终结果中选择适当的目标列
'标题字典并动态创建范围
对于LNGIX=1到lngLastSrcColNum
strColHeader=Trim（CStr（.Cells（1，lngIdx）））
'使用
'从最终标题字典中查找值
设置rngDst=wksDst.Cells（lngLastDstRowNum+1_
双财务负责人（STRCOLLHEADER））
'使用当前值设置源目标范围
'列编号和最后占用的行
设置rngSrc=.Range（.Cells（2，lngIdx）_
.Cells（lnglastssrcrownum，lngIdx））
'将此工作表中的数据复制到目标！
rngSrc.Copy Destination:=rngDst
下一个lngIdx
以
如果结束
下一届西九龙文娱艺术中心
“耶！让用户知道数据已合并
MsgBox“数据合并！”
端接头
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'输入：工作表，我们将搜索以查找最后一行的工作表
'输出：长，最后占用的行
'特殊情况：如果工作表为空，则返回1
公共函数LastOccupiedum（工作表形式）长度为
暗淡的液化天然气