=VLOOKUP(B2;C:C; 1 ;FALSE)

Sub DelVPRRezult()
Dim t
t = Timer
Application.ScreenUpdating =  0 
Dim x&, y&
Dim ws As Worksheet
Set ws = ActiveSheet
On Error Resume Next
With ws
    x = .UsedRange.Rows.Count
    Range("G1").Formula = "=VLOOKUP(B1,C:C,1,FALSE)"
    Range("G1").AutoFill Destination:=Range("G1:G" & x), Type:=xlFillDefault
    Application.Calculation = xlCalculationManual
    For y = x To  1  Step - 1 
    DoEvents
    If .Cells(y,  2 ).Value <> .Cells(y,  7 ).Value Then Else .Rows(y).EntireRow.Delete
    If y Mod  100  =  0  Then Application.StatusBar = "Working On Row " & y ' чтоб видеть процесс
    Next
End With
ws.Columns( 7 ).Clear
Application.ScreenUpdating =  1 
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
Debug.Print Timer - t
End Sub

 СЧЕТЕСЛИ -  25 . 20313  
 ИТОГО -  39 . 59375 

 ВПР -  6 . 15625  
 ИТОГО - 20 . 65625 

Range("G1").FormulaLocal = "=СЧЕТЕСЛИ(C:C;B1)"