我正在尝试在sheet_B / A列中的值(从A2开始)中搜索sheet_A,如果它们存在于sheet_A(C列,从C2开始)中,则它们将从sheet_A中删除。
Sub Remover_Duplicados()
'Backup to another sheet
Const strSheetName As String = "BKP_sheet"
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
If wsTest Is Nothing Then
Worksheets.Add.Name = strSheetName
End If
Sheets("sheet_A").Range("A1:BK3500").Copy Destination:=Sheets(strSheetName).Range("A1")
'Search and destroy
Dim searchableRange As Range
Dim toRemoveRange As Range
Dim lLoop As Long
Set searchableRange = Worksheets("sheet_B").Range("A2", "A3500")
Set toRemoveRange = Worksheets("sheet_A").Range("C2", "C3500")
For lLoop = searchableRange.Rows.Count To 2 Step -1
If WorksheetFunction.CountIf(searchableRange, toRemoveRange(lLoop).Value) > 0 Then
Worksheets("sheet_A").Rows(lLoop).Delete shift:=xlUp
End If
Next lLoop
End Sub
有些无法移除。
我已经遍历了您的代码,并对其进行了稍微的修改,以使范围更加动态,我还使用了一个数组来填充要删除的值,然后遍历该数组来决定是否应删除该行或不是:
Sub Remover_Duplicados()
'Backup to another sheet
Const strSheetName As String = "BKP_sheet"
Dim wsA As Worksheet: Set wsA = ThisWorkbook.Worksheets("Sheet_A")
Dim wsB As Worksheet: Set wsB = ThisWorkbook.Worksheets("Sheet_B")
Dim arrToRemove()
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ThisWorkbook.Worksheets(strSheetName)
On Error GoTo 0
If wsTest Is Nothing Then
Worksheets.Add.Name = strSheetName
End If
LastRowA = wsA.Cells(wsA.Rows.Count, "A").End(xlUp).Row
wsA.Range("A1:BK" & LastRowA).Copy Destination:=Sheets(strSheetName).Range("A1")
LastRowB = wsB.Cells(wsB.Rows.Count, "A").End(xlUp).Row
arrToRemove = wsB.Range("A2:A" & LastRowB).Value
For iRow = LastRowA To 2 Step -1
For iArray = LBound(arrToRemove) To UBound(arrToRemove)
If wsA.Cells(iRow, "C").Value = arrToRemove(iArray, 1) Then
wsA.Rows(iRow).EntireRow.Delete shift:=xlUp
End If
Next iArray
Next iRow
End Sub