如果存在其他工作表,则删除行

问题描述 投票:0回答:1

我正在尝试在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

表A,B和结果:result

有些无法移除。

excel vba
1个回答
1
投票

我已经遍历了您的代码,并对其进行了稍微的修改,以使范围更加动态,我还使用了一个数组来填充要删除的值,然后遍历该数组来决定是否应删除该行或不是:

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
© www.soinside.com 2019 - 2024. All rights reserved.