Sub TimKiem3333()
Dim arr(), KQ(), Key
Dim i&, j&, Lr&, t&, m&, n&, R&
Dim DicN As Object
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Set DicN = CreateObject("Scripting.Dictionary")
Dim Ws As Worksheet
Dim Time
Time = Timer
With Sheets("Data")
Lr = .Cells(.Rows.Count, 2).End(xlUp).Row
arr = .Range("B4:E" & Lr).Value
End With
Set Ws = Sheets("BaoCao")
Set Rng = Ws.Range(Ws.Cells(3, 3), Ws.Cells(3, Ws.Cells(3, Ws.Columns.Count).End(xlToLeft).Column))
Set eRng = Ws.Range("B4:B" & Ws.Range("B100000").End(xlUp).Row)
R = UBound(arr)
ReDim KQ(1 To eRng.Rows.Count, 1 To Rng.Columns.Count)
For d = 1 To eRng.Rows.Count
For c = 1 To Rng.Columns.Count
Key = eRng(d) & "|" & Rng(c)
If Not dic.Exists(Key) Then
dic(Key) = d & "|" & c
Else
dic(Key) = dic(Key) & "," & d & "|" & c
End If
Next c
Next d
For i = 1 To R
Key = arr(i, 3) & "|" & arr(i, 2)
If dic.Exists(Key) Then
t = t + 1
If InStr(dic(Key), ",") Then
S = Split(dic(Key), ",")
For j = LBound(S) To UBound(S)
S1 = Split(S(j), "|")
KQ(S1(0), S1(1)) = arr(i, 4) + KQ(S1(0), S1(1))
Next j
Else
S = Split(dic(Key), "|")
KQ(S(0), S(1)) = arr(i, 4) + KQ(S(0), S(1))
End If
End If
Next i
If t Then
Ws.Range("C4").Resize(100000, 1000).ClearContents
Ws.Range("C4").Resize(eRng.Rows.Count, Rng.Columns.Count) = KQ
MsgBox "Sub 3333 Xong:" & Timer - Time
End If
Set dic = Nothing
End Sub
