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對象，可以使用數組或集合等來完成。