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

Question

假设我有两张纸，第一张纸和第二张纸

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

如果在工作表2中找不到记录，则将删除工作表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错误方法的代码

    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 （Dictionary）中不存在的任何串联值，我们知道它是“新”行，因此我们将此数据添加到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对象，可以使用数组或集合等方法完成。