Удаление строк на основе диапазона данных

Question

Я хотел бы удалить целые строки на первом листе, если ячейки в столбце E содержат то же имя, которое находится в диапазоне B1:B30 на листе Ark3. Я попытался использовать приведенный ниже код, но он возвращает

Ошибка времени выполнения '13', Несоответствие типов.

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

Answer 1

Эффективным способом сравнения одного значения со многими другими является использование объекта словаря в качестве таблицы поиска. Примечание. В приведенном ниже примере я закомментировал оператор удаления для подтверждения правильности работы.

 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