Автоматизация. Поиск оптимального решения

Sub tt3()
  Dim n&, s$, refStyle
  
  With Application
    refStyle = .ReferenceStyle
    .ReferenceStyle = xlA1
    .ScreenUpdating = False
  End With
    
  n = Sheets(2).[a1].CurrentRegion.Rows.Count
  s = Sheets(2).Name
  
  With Sheets(1)
    .Range("K1:K2").Clear
    .Range("K2").Formula = "=MATCH(B3&""|""&F3,INDEX('" & s _
      & "'!B3:B" & n & "&""|""&'" & s & "'!F3:F" & n & ",),)"
    With .Range("A2:G" & .[a1].CurrentRegion.Rows.Count)
      .AdvancedFilter xlFilterInPlace, Sheets(1).Range("K1:K2")
MsgBox "Посмотрели? Удаляем! :)"
      .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With
    .Range("K1:K2").Clear
    .ShowAllData
  End With
  
  With Application
    .ReferenceStyle = refStyle
    .ScreenUpdating = True
  End With
End Sub

 'Сравнение массивов Items
   For m = 1 To UBound(ArrItems)
        For k = 1 To UBound(ArrItems2)
            If ArrItems(m) = ArrItems2(k) Then
                dicData2.Remove (k) ' и не удаляет.
            End If
        Next
    Next

Option Explicit
 
Sub tt()
    Dim a(), i&, multyRange As Range
 
    With CreateObject("scripting.dictionary"): .comparemode = 1
 
        a = Sheets(2).[a1].CurrentRegion.Value
        'заносим ключи в словарь
        For i = 3 To UBound(a): .Item(a(i, 2) & "|" & a(i, 6)) = Empty: Next
 
        a = Sheets(1).[a1].CurrentRegion.Value
        For i = 3 To UBound(a)
            'проверяем на дубликат в словаре
            If .exists(a(i, 2) & "|" & a(i, 6)) Then
                'если есть повтор - собираем диапазон на удаление
                If multyRange Is Nothing Then Set multyRange = Cells(i, 1) Else Set multyRange = Union(multyRange, Cells(i, 1))
            End If
        Next
 
        '        multyRange.Select
        '        MsgBox "Посмотрели? Удаляем! :)"
        multyRange.EntireRow.Delete
    End With
 
End Sub