如何通过Excel VBA对比两个工作表并补全缺失ID且保留对应注释

功能说明 #

• 自动比对Main与Data工作表第一列的ID数据
• 仅将Main表缺失的ID追加到Main表末尾空行，不会修改Main表已有的ID与对应注释
• 自动对Main表全表按ID升序排序，整行绑定数据，避免ID与注释错位
• 支持自定义表头配置，适配有无表头的场景

完整VBA代码 #

Sub 同步ID并排序()
    Dim wsMain As Worksheet, wsData As Worksheet
    Dim idDict As Object
    Dim lastRowData As Long, lastRowMain As Long, i As Long
    Dim appendRow As Long
    
    ' 绑定对应工作表
    Set wsMain = ThisWorkbook.Worksheets("Main")
    Set wsData = ThisWorkbook.Worksheets("Data")
    Set idDict = CreateObject("Scripting.Dictionary") ' 用于存储已存在的ID，提高比对效率
    
    ' 读取Main表已有ID存入字典
    lastRowMain = wsMain.Cells(wsMain.Rows.Count, "A").End(xlUp).Row
    ' 若表无表头，下方循环起始值2改为1
    For i = 2 To lastRowMain
        If Not idDict.exists(wsMain.Cells(i, "A").Value) Then
            idDict.Add wsMain.Cells(i, "A").Value, vbNullString
        End If
    Next i
    
    ' 比对Data表ID，追加缺失ID到Main表末尾
    lastRowData = wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row
    appendRow = lastRowMain + 1
    ' 若Data表无表头，下方循环起始值2改为1
    For i = 2 To lastRowData
        If Not idDict.exists(wsData.Cells(i, "A").Value) Then
            wsMain.Cells(appendRow, "A").Value = wsData.Cells(i, "A").Value
            appendRow = appendRow + 1
            idDict.Add wsData.Cells(i, "A").Value, vbNullString
        End If
    Next i
    
    ' 对Main表全表排序，整行绑定避免错位
    lastRowMain = wsMain.Cells(wsMain.Rows.Count, "A").End(xlUp).Row
    With wsMain.Sort
        .SortFields.Clear
        ' 按第一列（ID列）升序排序
        .SortFields.Add Key:=wsMain.Range("A2:A" & lastRowMain), Order:=xlAscending
        ' 选中所有连续数据区域整表排序
        .SetRange wsMain.Range("A1").CurrentRegion
        .Header = xlYes ' 无表头请改为xlNo
        .Apply
    End With
    
    ' 释放内存
    Set idDict = Nothing
    Set wsMain = Nothing
    Set wsData = Nothing
    
    MsgBox "操作完成，已同步缺失ID并完成排序", vbInformation
End Sub

使用注意事项 #

• 包含宏的工作簿请保存为.xlsm格式，防止代码丢失
• 运行前请确认工作表名称为Main和Data，若名称不同请修改代码中对应工作表名称参数
• 排序逻辑默认将整行数据绑定移动，不会出现ID和对应注释错位的问题

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