比較兩個不同的工作表中的兩個單元格並刪除任何重複的內容

Question

我遇到了一些宏代碼的問題，我從我在網上找到的一些代碼改編了一些代碼，並想知道是否有人能夠提供幫助。

本質上，我希望宏運行並將「工作列表」工作表中的兩個單元格與「導入此處」工作表中的條目進行比較，並刪除任何重複項。

當我運行代碼時，它似乎在標題單元格上工作，但似乎沒有工作。

任何幫助將不勝感激。

這裏是下面的代碼：我也嘗試了自己的理解註釋。

Sub Comparison_Macro() 
Dim iListCount As Integer 
Dim iCtr As Integer 

' Turn off screen updating to speed up macro. 
Application.ScreenUpdating = False 

' Get count of records to search through (list that will be deleted). 
iListCount = Sheets("Import Here").Range("A1:A1000").Rows.Count 

' Loop through the "master" list. 
For Each x In Sheets("Working List").Range("A1:A30") 
    ' Loop through all records in the second list. 
    For iCtr = 1 To iListCount 
    ' Do comparison of Column A in next record. 
    If x.Value = Sheets("Import Here").Cells(iCtr, 1).Value Then 
     'Do comparison of Column B in next record. 
     If Sheets("Working List").Cells(iCtr, 2) = Sheets("Import Here").Cells(iCtr, 2).Value Then 
      ' If match is true for Columns A and B then delete row. 
      Sheets("Import Here").Cells(iCtr, 1).EntireRow.Delete xlShiftUp 
     End If 
    ' Increment counter to account for deleted row. 
    iCtr = iCtr + 1 
    End If 
Next iCtr 
Next 
Application.ScreenUpdating = True 
MsgBox "Done!" 
End Sub 

Answer 1

以下是使用countifs檢查「工作列表」工作表上是否存在「導入此處」的列A和B的版本。由於它是從「Import Here」表單中刪除行，所以代碼在每行中循環並在「Working List」表單中找到時刪除。

我的評論並不完全正確，因爲我沒有看到您在一張紙上爲每一行循環讀取另一張紙上的每一行，所以它可能沒有失去同步。這說我仍然認爲使用countifs是一個更好的方法來做到這一點。

Sub Comparison_Macro() 
    Dim iListCount As Integer 
    Dim iCtr As Integer 

    ' Turn off screen updating to speed up macro. 
    Application.ScreenUpdating = False 

    ' Get count of records to search through (list that will be deleted). 
    iListCount = Sheets("Import Here").Range("A1:A1000").Rows.Count 

    ' Loop through the "master" list. 
    For iCtr = 1 To iListCount 
     ' Loop through all records in the second list. 

     ' Do comparison of Column A and B in next record. 

     If Application.WorksheetFunction.CountIfs(Range("'Working List'!A1:A1000"), Range("A" & iCtr), Range("'Working List'!B1:B1000"), Range("B" & iCtr)) > 0 Then 
      Sheets("Import Here").Cells(iCtr, 1).EntireRow.Delete xlShiftUp 
      iCtr = iCtr - 1 
     End If 

    Next iCtr 
    Application.ScreenUpdating = True 
    MsgBox "Done!" 
End Sub 

Answer 2

您coudl考慮一個Autofilter()方法：

Sub Comparison_Macro() 
    Dim workingRng As Range, importRng As Range, deleteRng As Range, cell As Range 

    With Worksheets("Working List") '<--| reference "Working List" sheet 
     Set workingRng = .Range("A1", .cells(.Rows.Count, 1).End(xlUp)) '<--| set the "Working List" sheet column A values from row 1 down to last not empty row to be checked in "Import Here" sheet 
    End With 

    With Sheets("Import Here") '<--| reference "Import Here" sheet 
     With .Range("A1", .cells(.Rows.Count, 1).End(xlUp)) '<--| reference its column A range from row 1 down to last not empty row 
      .AutoFilter Field:=1, Criteria1:=Application.Transpose(workingRng.Value), Operator:=xlFilterValues '<--| filter referenced cells with 'workingRng' values 
      Set importRng = .SpecialCells(xlCellTypeVisible) '<--| set filtered cells to 'importRng' range 
      Set deleteRng = .Offset(, 1).Resize(1, 1) '<--| initialize 'deleteRng' to a "dummy" cell that's out of range of interest: it'll be used to avoid subsequent checking against "nothing" before calling 'Union()' method and eventually discharged 
     End With 
     .AutoFilterMode = False 
    End With 

    For Each cell In importRng '<--| loop through filtered cells in "Import Here" 
     If workingRng.Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(, 1) = cell.Offset(, 1) Then Set deleteRng = Union(deleteRng, cell) '<--| if current cell adjacent value matches corresponding value in "working range" then update 'deletRng' 
    Next 
    Set deleteRng = Intersect(importRng, deleteRng) '<--| get rid of "dummy" cell 
    If Not deleteRng Is Nothing Then deleteRng.EntireRow.Delete '<--| if any survived cell in "Import Here" then delete corresponding rows 
End Sub