学以致用——使用VBA合并文档结构不相同的Excel文件（Merge data in Excel files with different data structure）

需求：有十几个Excel文件中的数据需要合并到一个Excel中进行处理，但每个文件中字段的个数、顺序不相同。如果手动复制、粘贴，耗时至少20分钟，而且容易出错。现考虑使用VBA，一次痛苦，节省以后的大量时间。

分析思路：既然结构不相同，就根据每个文件的特点，分别定义合并方法（按需复制、粘贴）。

代码示例：

Sub Consolidate()
Dim bt As Range, r As Long
r = 1 '列头行数

Dim used_rows As Long '定义数据区行数
Dim filename As String  '定义文件名变量
Dim wb As Workbook      '定义工作簿变量
Dim currentRow As Long        '定义合并工作簿中的数据行数变量
Dim fullFileName As String        '定义带路径的文件名变量
Dim rng As Range                '定义缓存待合并数据的变量
Dim i As Long        '定义循环变量
Dim totalRow As Integer     '定义合并完成后的数据总行数
Const maxRow As Long = 1048576 'Excel 2010中单张工作表最大行数为：1048576


Application.ScreenUpdating = False      '不显示中间的操作过程

used_rows = ThisWorkbook.Worksheets("output").UsedRange.rows.Count
Worksheets("output").Range("A" & (r + 1) & ":" & "J" & (used_rows + 1)).Clear '合并数据前，先清空数据区


filename = Dir(ThisWorkbook.path & "\*.xlsx") '指定待合并文件路径
Do While filename <> ""         '依次操作各待合并文件（work文件除外）
    If filename <> ThisWorkbook.name Then   'work文件除外
        fullFileName = ThisWorkbook.path & "\" & filename '确定待合并文件的完整文件名
        Set rng = Worksheets("output").Range("A1048576").End(xlUp).Offset(1, 0) '获取合并区的第一个空行
        Set wb = GetObject(fullFileName) '获取待合并文件对象
        Set sht = wb.Worksheets(1)      '待合并数据位于第一个工作表中
        used_rows = sht.UsedRange.rows.Count '获取待合并数据区的行数

        '处理以下文件：FileA
        If wb.name = "FileA.xlsx" Then
            sht.Range("B7:B" & used_rows).Copy Worksheets("output").Cells(rng.row, "B") '将有效数据复制到合并目标区
            sht.Range("C7:C" & used_rows).Copy Worksheets("output").Cells(rng.row, "C") '将有效数据复制到合并目标区
            sht.Range("O7:O" & used_rows).Copy Worksheets("output").Cells(rng.row, "F") '将有效数据复制到合并目标区
            sht.Range("F7:F" & used_rows).Copy Worksheets("output").Cells(rng.row, "D") '将有效数据复制到合并目标区
            Worksheets("output").Range("A" & rng.row & ":A" & (rng.row + used_rows - 7)).Value = "FileA"
            Worksheets("output").Range("G" & rng.row & ":G" & (rng.row + used_rows - 7)).Value = "ManualMerge"
        End If
        
        '处理以下文件：FileB
        If wb.name = "FileB.xlsx" Then
            sht.Range("A7:A" & used_rows).Copy Worksheets("output").Cells(rng.row, "B") '将有效数据复制到合并目标区
            sht.Range("C7:C" & used_rows).Copy Worksheets("output").Cells(rng.row, "C") '将有效数据复制到合并目标区
            sht.Range("Q7:Q" & used_rows).Copy Worksheets("output").Cells(rng.row, "F") '将有效数据复制到合并目标区
            sht.Range("E7:E" & used_rows).Copy Worksheets("output").Cells(rng.row, "D") '将有效数据复制到合并目标区
            Worksheets("output").Range("A" & rng.row & ":A" & (rng.row + used_rows - 7)).Value = "FileB"
            Worksheets("output").Range("G" & rng.row & ":G" & (rng.row + used_rows - 7)).Value = "ManualMerge"
        End If
        
    End If
filename = Dir
Loop

totalRow = Worksheets("output").Range("A" & maxRow).End(xlUp).row
Worksheets("output").Select
Worksheets("output").Range("A" & totalRow).Select
MsgBox ("Merge completed! " & (totalRow - 1) & " rows of raw data in total")

Application.ScreenUpdating = True
End Sub