Excel的VBA - 删除/记录从片材复制到另一个

Question

可以说我有两片，薄板1和表2

我在Sheet四列并且在片材3个类似的列标题2.

如果在工作表2中找不到工作表1中的记录，它将被删除。

从片材2的记录被复制到片材1，如果它不是已存在于片1

Sheet 1中我有以下列

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的连接列，现在失去了想法。

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 
'--------------------------------' 

下面是代码，我正在用在错误的方法

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对象，可以使用数组或集合等来完成。