VBA实现两表格匹配：同步匹配值列索引并填充匹配索引列

以下是一段可实现需求的VBA代码，核心逻辑是匹配两个表格的表头内容，将第二个表格的列调整为与第一个表格一致的顺序：

Sub AlignTableColumns()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim sourceHeaderRange As Range, targetHeaderRange As Range
    Dim sourceCell As Range, foundCell As Range
    Dim colOffset As Integer
    
    ' 定义两个表格所在的工作表，根据实际情况修改名称
    Set wsSource = ThisWorkbook.Worksheets("Sheet1") ' 第一个表格所在工作表
    Set wsTarget = ThisWorkbook.Worksheets("Sheet2") ' 第二个表格所在工作表
    
    ' 假设表头在第一行，获取表头列范围（从A列到最后一个有数据的列）
    Set sourceHeaderRange = wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(1, wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column))
    
    ' 遍历第一个表格的每个表头单元格
    For Each sourceCell In sourceHeaderRange
        ' 在第二个表格的第一行查找匹配的表头
        Set foundCell = wsTarget.Rows(1).Find(What:=sourceCell.Value, LookIn:=xlValues, LookAt:=xlWhole)
        
        If Not foundCell Is Nothing Then
            ' 如果找到匹配项，且当前位置和目标位置不一致，调整列顺序
            If foundCell.Column <> sourceCell.Column Then
                ' 计算列偏移量，避免移动时影响后续索引
                colOffset = IIf(foundCell.Column > sourceCell.Column, 0, 1)
                wsTarget.Columns(foundCell.Column).Cut
                wsTarget.Columns(sourceCell.Column + colOffset).Insert Shift:=xlToRight
            End If
        End If
    Next sourceCell
    
    MsgBox "列索引匹配对齐完成！", vbInformation
End Sub

代码说明： #

• 请根据实际表格所在的工作表名称修改wsSource和wsTarget的工作表名称
• 代码默认表头在第一行，如果你的表头在其他行，修改代码中Rows(1)和Cells(1, ...)的行号即可
• 使用xlWhole进行精确匹配，确保表头内容完全一致才会对齐
• 处理列移动时的索引偏移问题，避免因列顺序变化导致的匹配错误
• 执行完成后会弹出提示框告知操作完成

内容的提问来源于stack exchange，提问作者Taha Er