Sub compare()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim dict As Object, dict1 As Object
Dim ShI As Worksheet, ShF As Worksheet
Dim lri As Integer, lrf As Integer
Dim val As Variant
tim1 = Now
Set dict = CreateObject("Scripting.Dictionary")
Set dict1 = CreateObject("Scripting.Dictionary")
Set ShI = ThisWorkbook.Sheets("I")
Set ShF = ThisWorkbook.Sheets("F")
lri = ShI.Cells(Rows.Count, 1).End(xlUp).Row
lrf = ShF.Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To lri
If Len(ShI.Cells(i, 3)) = 1 Then
If Len(ShI.Cells(i, 4)) = 1 Then
val = ShI.Cells(i, 2) & "0" & ShI.Cells(i, 3) & "0" & ShI.Cells(i, 4) & ShI.Cells(i, 5) & ShI.Cells(i, 6)
dict.Add Key:=val, Item:=ShI.Cells(i, 7)
dict1.Add Key:=val, Item:=ShI.Cells(i, 8)
Else: val = ShI.Cells(i, 2) & "0" & ShI.Cells(i, 3) & ShI.Cells(i, 4) & ShI.Cells(i, 5) & ShI.Cells(i, 6)
dict.Add Key:=val, Item:=ShI.Cells(i, 7)
dict1.Add Key:=val, Item:=ShI.Cells(i, 8)
End If
Else:
If Len(ShI.Cells(i, 4)) = 1 Then
val = ShI.Cells(i, 2) & ShI.Cells(i, 3) & "0" & ShI.Cells(i, 4) & ShI.Cells(i, 5) & ShI.Cells(i, 6)
dict.Add Key:=val, Item:=ShI.Cells(i, 7)
dict1.Add Key:=val, Item:=ShI.Cells(i, 8)
Else: val = ShI.Cells(i, 2) & ShI.Cells(i, 3) & ShI.Cells(i, 4) & ShI.Cells(i, 5) & ShI.Cells(i, 6)
dict.Add Key:=val, Item:=ShI.Cells(i, 7)
dict1.Add Key:=val, Item:=ShI.Cells(i, 8)
End If
End If
Next i
For j = 3 To lrf
key_check = ShF.Cells(j, 3) & ShF.Cells(j, 4) & ShF.Cells(j, 5) & ShF.Cells(j, 6) & ShF.Cells(j, 7)
If dict.exists(key_check) Then
ShF.Cells(j, 10) = dict(key_check)
ShF.Cells(j, 11) = dict1(key_check)
End If
Next j
Set dict = Nothing
Set dict1 = Nothing
tim2 = Now
MsgBox Format(tim2 - tim1, "ss.ms")
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub