Поиск и сравнение значений в столбцах по двум параметрам

Sub test()
Dim mass(), ws As Worksheet, dc, i As Long
Application.ScreenUpdating = False
Set ws = ActiveSheet
mass() = ws.Range("A1").CurrentRegion.Value
Set dc = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(mass, 1)
    dc.Add mass(i, 3), mass(i, 4)
Next
For i = 2 To UBound(mass, 1)
    If dc.exists(mass(i, 1)) Then
        If mass(i, 2) = dc.Item(mass(i, 1)) Then
            mass(i, 2) = ""
        Else
            mass(i, 2) = mass(i, 2) - dc.Item(mass(i, 1))
        End If
    Else
        mass(i, 2) = "Íîìåð çàêàçà íå íàéäåí"
    End If
    ws.Range("F" & i).Value = mass(i, 1)
    ws.Range("G" & i).Value = mass(i, 2)
Next
Application.ScreenUpdating = True
End Sub

Sub CompareSub()
 
Dim ACell As Range
Dim CCell As Range
Dim i As Integer
 i = 0
    For Each ACell In Range("A2", Cells(Rows.Count, 1).End(xlUp))
    For Each CCell In Range("C2", Cells(Rows.Count, 3).End(xlUp))
         If CCell.Value = ACell.Value Then
            a = 0
            b = 0
            a = ACell.Offset(0, 1)
            b = CCell.Offset(0, 1)
           
            If i = 0 Then
            CCell.Offset(0, 3) = b - a
            End If
            
            If i > 0 Then
            CCell.Offset(0, 3) = CCell.Offset(0, 3) - a
            'CCell.Offset(0, 4) = CCell.Offset(0, 4) + CCell.Offset(0, 3)
            End If
            CCell.Interior.Color = 5296274
            i = i + 1
         End If
      Next
      Next
  
 
End Sub

Option Explicit
 
Sub compare()
    Dim a(), i&, ii&
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
 
        With CreateObject("scripting.dictionary")
 
            With GetObject([a1])
                a = .Sheets(1).[a1].CurrentRegion.Value: .Close 0
            End With
            For i = 2 To UBound(a): .Item(a(i, 1)) = a(i, 2): Next
 
            With GetObject([a2])
                a = .Sheets(1).[a1].CurrentRegion.Value: .Close 0
            End With
            ii = 1
            For i = 2 To UBound(a)
                If .exists(a(i, 1)) Then
                    ii = ii + 1: a(ii, 1) = a(i, 1)
                    a(ii, 2) = .Item(a(i, 1)) - a(i, 2)
                End If
            Next
 
        End With
        If ii > 1 Then Workbooks.Add(1).Sheets(1).[a1].Resize(ii, 2) = a
 
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub