Option Explicit

'Макросом -
'1.два диапазона в два массива
'2.создание массива для результатов
'3.один перебор 300 значений массива в словарь
'4.100 000 проверок массива на наличие в словаре и заполнение данными массива результата
'5.выгрузка результатов (тут нет предварительной очистки диапазона)

Sub compare()
          Dim a(), b(), iLastrow As Long, i As Long, ii As Long

          '1.
          With Лист1    'используется кодовое имя
              iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
              a = Range(.[c1], .Range("A" & iLastrow)).Value
          End With

          With Лист2    'используется кодовое имя
              iLastrow = .Cells(Rows.Count, 1).End(xlUp).Row
              b = Range(.[A1], .Range("A" & iLastrow)).Value
          End With

          '2.
          ReDim c(1 To UBound(a), 1 To 3)

          With CreateObject("Scripting.Dictionary")
                
              '3.
              For i = 1 To UBound(b)
                  .Item(b(i, 1)) = i
              Next

              '4.
              For i = 1 To UBound(a)
                  If Not .exists(a(i, 1)) Then
                      ii = ii + 1
                      c(ii, 1) = a(i, 1)
                      c(ii, 2) = a(i, 2)
                      c(ii, 3) = a(i, 3)
                  End If
              Next
          End With

          '5.
          With Лист3    'используется кодовое имя
              .[A1].Resize(ii, 3) = c
              .Activate
          End With

End Sub

a = Range(.[c1], .Range("A" & iLastrow)).Value

c(ii, 1) = a(i, 1)      
c(ii, 2) = a(i, 2)      
c(ii, 3) = a(i, 3)

Sub ertert()
Dim str$, x, y(), i&, j&, k&
str = Join(WorksheetFunction.Transpose(Sheets("Лист2").Columns(1).SpecialCells(2)), ",")

x = Sheets("Лист1").Range("A1").CurrentRegion.Value
ReDim y(1 To UBound(x, 1), 1 To UBound(x, 2))
For i = 1 To UBound(x)
     If InStr(str, x(i, 1)) = 0 Then
         k = k + 1
         For j = 1 To UBound(x, 2)
             y(k, j) = x(i, j)
         Next j
     End If
Next i

Sheets("Лист3").Range("A1").Resize(k, UBound(x, 2)).Value = y()
End Sub