Excel VBA – 删除/复制一个logging从一个表到另一个
让我说我有两张纸，表1和表2
在Sheet1中有四个列，在Sheet2中有三个类似的列标题。
如果在工作表2中找不到工作表1中的logging，则会将其删除。
如果纸张1中的logging不在纸张1中，则来自纸张2的logging被复制到纸张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 MM 23 M
而我的输出需要在sheet1中：
Name Age Gender Group A 24 M B1 M 23 M C1 F 25 M
注意：每个logging每次按照名称，年龄和性别的组合而不仅仅是名称而被删除/复制。
我创build了一个使用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
这似乎是诀窍。 这里有两个循环，在第一个循环中，我们看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对象，可以用数组或集合等来完成。