Excel VBA - 删除/将记录从工作表复制到另一个工作表

Question

假设我有两张表，表 1 和表 2

我在工作表 1 中有四列，在工作表 2 中有三个类似的列标题。

如果在 sheet2 中找不到来自 sheet 1 的记录，则将其删除。

如果工作表 1 中没有记录，则将工作表 2 中的记录复制到工作表 1。

在 Sheet1 中，我有以下列

Name Age Gender  Group
I    25    M     A1
A    24    M     B1
M    23    M     C1
E    23    M     D1

在表 2 中，我有以下列

Name Age Gender
F    25    M
A    24    M   
M    23    M

我的输出需要在 sheet1 中：

Name Age Gender Group
  A    24    M   B1
  M    23    M   C1
  F    25    M

注意：每次都会根据姓名、年龄和性别的组合删除/复制每条记录，而不仅仅是姓名。

我使用 VBA 创建了一个 Concatenated 列，但现在失去了灵感。

For j = 2 To lastrow

        strA = Sheets(TabName).Range("A" & j).Value
        strB = Sheets(TabName).Range("B" & j).Value
        StrC = Sheets(TabName).Range("C" & j).Value

        Range(CombinedKeyColLet & j).Value = Application.WorksheetFunction.Concat(strA & strB & StrC)

        Cells.Select
        Selection.Columns.AutoFit

        Next
'Copy or Delete code
'--------------------------------'

这是我正在尝试使用 On error 方法的代码

    CombinedKeyCol = WorksheetFunction.Match("CombinedKey", Sheets(TabName1).Rows(1), 0)
    CombinedKeyColLet = GetColumnLetter(CombinedKeyCol)

    For i = lastrow To 2 Step -1
              Sheets(TabName2).Activate
              CombinedKeyVal = Range(CombinedKeyColLet & i).Value
              On Error GoTo Jumpdelete
                Present = WorksheetFunction.Match(CombinedKeyVal, Sheets(TabName1).Columns(6), 0)
               If Present <> "" Then
               GoTo Jumpdontdelete
               End If
Jumpdelete:
    Sheets(TabName2).Activate
    Rows(i & ":" & i).Delete
    Present = ""
Jumpdontdelete:
    Present = ""
    Next

Answer 1

这似乎可以解决问题。这里有两个循环，在第一个循环中，我们查看tbl1 中的每一行，看看它是否存在于tbl2 中。如果没有，那么我们将其删除。如果它确实存在，我们将它的连接值放在Dictionary 中，这样我们就可以记住它在两个地方都存在。在第二个循环中，我们遍历tbl2，对于dict（字典）中不存在的任何连接值，我们知道这是一个“新”行，因此我们将此数据添加到tbl1。

Option Explicit
Sub foo()
Dim j As Long
Dim rng As Range
Dim tbl1 As Range, tbl2 As Range
Dim dict As Object
Dim val As String
Dim r As Variant
Dim nextRow

Set dict = CreateObject("Scripting.Dictionary")

With Sheet2
    Set tbl2 = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row).CurrentRegion
    tbl2.Columns(4).Formula = "=c[-3]&c[-2]&c[-1]"
End With
With Sheet1
    Set tbl1 = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row).CurrentRegion
End With

For j = tbl1.Rows.Count To 2 Step -1
    'Does this row exist in Table2?
    val = tbl1.Cells(j, 1) & tbl1.Cells(j, 2) & tbl1.Cells(j, 3)
    r = Application.Match(val, tbl2.Columns(4), False)
    If IsError(r) Then
        tbl1.Rows(j).Delete Shift:=xlUp
    Else
        dict(val) = ""  'Keep track that this row exists in tbl1 AND tbl2
    End If
Next
tbl2.Columns(4).ClearContents
Set tbl2 = tbl2.Resize(, 3)
For j = 2 To tbl2.Rows.Count
    val = Join(Application.Transpose(Application.Transpose(tbl2.Rows(j).Value)), "")
    'If the value doesn't exist, then we add row to Tbl1:
    If Not dict.Exists(val) Then
        nextRow = tbl1.Cells(1, 1).End(xlDown).Row + 1
        tbl1.Rows(nextRow).Resize(, 3).Value = tbl2.Rows(j).Value
    End If
Next

End Sub

注意：这必然假设姓名/年龄/性别连接的唯一性。如果可能有重复，则需要修改此方法以不使用Dictionary 对象，可以使用数组或集合等来完成。