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列是否在＆＃34;导入此处＆＃34;存在于＆＃34;工作清单＆＃34;片。因为它正在删除＆＃34; Import Here＆＃34;将代码循环遍历每一行，如果在＆＃34;工作列表＆＃34;中找到它，则删除它们。片材。

我的评论并不完全正确，因为我没有看到你在另一张纸上为每一行循环遍历每一行，所以它可能不会失去同步。这就是说我仍然认为使用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

您可以考虑使用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

比较两个不同工作表中的两个单元格并删除任何重复项

2 个答案: