根据数据范围删除行

Deleting rows based on a range of data

如果 E 列中的单元格包含在工作sheet sheet [=12] 范围内找到的相同名称,我想删除第一个 sheet 中的整行=].我尝试使用下面的代码,但它 returns

Run-time error '13', Type mismatch.

Sub sbDelete_Rows_IF_Cell_Contains_String_Text_Value()
    Dim lRow As Long
    Dim iCntr As Long
    lRow = 500
    For iCntr = lRow To 1 Step -1
        If Cells(iCntr, 5).Value = ThisWorkbook.Worksheets("Ark3").Range("B1:B30") Then
            Rows(iCntr).Delete
        End If
    Next
End Sub

将一个值与许多其他值进行比较的一种有效方法是使用 dictionary object 作为查找 table。注意:在下面的示例中,我已将删除语句注释掉,以确认操作是否正确。

 Option Explicit

 Sub sbDelete_Rows_Matching()

   Dim wsFirst, wsArk3 As Worksheet
   With ThisWorkbook
     Set wsFirst = .Sheets(1)
     Set wsArk3 = .Sheets("Ark3")
   End With

   ' create lookup table
   Dim lookup
   Set lookup = CreateObject("Scripting.Dictionary")
   Dim cell As Range, key As String
   For Each cell In wsArk3.Range("B1:B30").Cells
     key = cell.Value
     If Len(key) > 0 Then
       If lookup.exists(key) Then
         MsgBox "Ark3 has duplicate value" & vbCr & key, vbCritical, "Warning"
       Else
         lookup.Add key, cell.row
       End If
     End If
   Next cell

   ' process sheet 1
   Dim r, count, lastRow As Long
   count = 0
   Application.ScreenUpdating = False
   With wsFirst
     lastRow = .Range("E" & .Rows.count).End(xlUp).row
     For r = lastRow To 1 Step -1
       If lookup.exists(.Cells(r, 5).Value) Then
         .Cells(r, 5).Interior.Color = vbYellow
         ' .Rows(r).Delete
         count = count + 1
       End If
     Next r
     .Range("A1").Select
   End With
   Application.ScreenUpdating = True
   MsgBox count & " rows deleted"

 End Sub