Sub GPE()
Dim Dic As Object, Key, Lc%, j%, Res()
Dim i&, Lr&, Arr(), txt As Variant, k&
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("DATA")
Lr = .Range("A" & Rows.Count).End(xlUp).Row
Arr = .Range("A2:E" & Lr).Value
End With
For i = 1 To UBound(Arr)
Key = Arr(i, 1) & "|" & Arr(i, 2)
If Not Dic.exists(Key) Then
Dic.Add (Key), Arr(i, 3) * Arr(i, 4) * Arr(i, 5) & "|" & Arr(i, 3) * Arr(i, 4)
Else
txt = Split(Dic.Item(Key), "|")
Dic.Item(Key) = CDbl(txt(0)) + Arr(i, 3) * Arr(i, 4) * Arr(i, 5) & "|" & CDbl(txt(1)) + Arr(i, 3) * Arr(i, 4)
End If
Next i
With ThisWorkbook.Sheets("TH_NS")
Lc = .Cells(6, .Columns.Count).End(xlToLeft).Column
Lr = .Range("B" & Rows.Count).End(xlUp).Row
Arr = .Range(.Cells(6, 2), .Cells(Lr, Lc - 1)).Value
ReDim Res(1 To UBound(Arr) - 2, 1 To UBound(Arr, 2))
For i = 3 To UBound(Arr)
For j = 2 To UBound(Arr, 2)
Key = Arr(i, 1) & "|" & Arr(1, j)
If Dic.exists(Key) Then
txt = Split(Dic.Item(Key), "|")
Res(i - 2, j - 1) = txt(0) / txt(1)
Else
Res(i - 2, j - 1) = ""
End If
Next j
Next i
.Range("C8").Resize(i - 3, j - 1).Value = Res
End With
MsgBox "Done"
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub
