如何使用VBA向Excel目标表格追加数据并更新匹配记录？

源数据表 #

目标表（结构与源表一致，位于其他工作表） #

功能需求 #

• 检查目标表是否包含源数据中的ID
• 若ID不存在，将源数据对应行追加至目标表
• 若ID已存在且值不同，根据源数据更新目标表记录
  重要要求：代码不得删除目标表中的行，源数据删除行时，目标表需保留该行，仅允许新增或更新记录

现有参考代码问题 #

我有一段来自Stack Overflow的参考代码，但它是按经理名分流数据至不同工作表，且无更新记录功能，不符合我的需求：

' COPY, PASTE AND APPEND   
Sub Append()

Dim manager As String, lastrow As Long, i As Integer, k as integer, j as integer
Dim find As Range, bill As String

bill = Sheets("Sheet1").Range("A:A").Value
Do While Not bill = ""
Set find = Sheets("Sheet1").Range("A:A").find(what:=bill, lookat:=xlValues, lookat:=xlWhole)

If find Is Nothing Then

lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).row

For i = 2 To lastrow
    If Cells(i, 2) = "JOHN" Then
    Range(Cells(i, 1), Cells(i, 6)).copy
    Sheets("Sheet13").Range("A300").End(xlUp).Offset(1, 0).PasteSpecial
    End If
Next i

For j = 2 To lastrow
    If Sheets("Sheet1").Cells(j, 2) = "CHARLIE" Then
    Sheets("Sheet1").Range(Cells(j, 1), Cells(j, 6)).copy
    Sheets("Sheet11").Range("A300").End(xlUp).Offset(1, 0).PasteSpecial
    End If
Next j

For k = 2 To lastrow
    If Sheets("Sheet1").Cells(k, 2) = "GEORGE" Then
    Sheets("Sheet1").Range(Cells(k, 1), Cells(k, 6)).copy
    Sheets("Sheet12").Range("A300").End(xlUp).Offset(1, 0).PasteSpecial
    End If
Next k

Else

Sheets("Sheet1").Select

End If
Loop

End Sub

适配需求的VBA代码 #

以下是符合需求的代码，需根据实际工作表名称修改sourceSheetName和targetSheetName变量：

Sub UpdateOrAppendData()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceLastRow As Long
    Dim targetLastRow As Long
    Dim sourceRow As Long
    Dim foundId As Range
    
    ' 替换为实际的源表、目标表名称
    Const sourceSheetName As String = "源数据表"
    Const targetSheetName As String = "目标表"
    
    ' 初始化工作表对象
    Set sourceSheet = ThisWorkbook.Worksheets(sourceSheetName)
    Set targetSheet = ThisWorkbook.Worksheets(targetSheetName)
    
    ' 获取源表最后一行数据（跳过表头）
    sourceLastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历源表每一条数据
    For sourceRow = 2 To sourceLastRow
        Dim currentId As String
        currentId = sourceSheet.Cells(sourceRow, "A").Value
        
        ' 在目标表ID列查找当前ID
        Set foundId = targetSheet.Range("A:A").Find( _
            What:=currentId, LookIn:=xlValues, LookAt:=xlWhole)
        
        If foundId Is Nothing Then
            ' ID不存在，追加到目标表末尾
            targetLastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
            targetSheet.Cells(targetLastRow + 1, "A").Value = sourceSheet.Cells(sourceRow, "A").Value
            targetSheet.Cells(targetLastRow + 1, "B").Value = sourceSheet.Cells(sourceRow, "B").Value
        Else
            ' ID已存在，仅当值不同时更新
            If targetSheet.Cells(foundId.Row, "B").Value <> sourceSheet.Cells(sourceRow, "B").Value Then
                targetSheet.Cells(foundId.Row, "B").Value = sourceSheet.Cells(sourceRow, "B").Value
            End If
        End If
    Next sourceRow
    
    MsgBox "数据更新/追加完成！", vbInformation
End Sub

代码说明 #

• 以ID为唯一标识，遍历源表所有数据
• 目标表无对应ID时，直接追加整行数据
• ID已存在时，仅当Color值不同才更新目标表记录
• 全程保留目标表原有行数据，不会执行删除操作

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