Sub Compare2Terms()
Dim Dic1 As Object, Dic2 As Object
Dim Thang8(), Kytruoc(), Res()
Dim R As Long, K1 As Long, K2 As Long, I As Long
Application.ScreenUpdating = False
'Mo thu vien Scripting.Dictionary
Set Dic1 = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
'Mang chua du lieu goc Thang 8
Thang8 = Sheet2.Range("B2:G" & Sheet2.Range("B" & Rows.Count).End(xlUp).Row)
'Quy dinh kich thuoc mang ket qua
ReDim Res(1 To UBound(Thang8, 1), 1 To 6)
'Mang chua du lieu goc Ky truoc
Kytruoc = Sheet3.Range("B2:E" & Sheet3.Range("B" & Rows.Count).End(xlUp).Row)
'Chay vong lap theo chieu thu nhat cua mang Thang 8
For R = 1 To UBound(Thang8, 1)
'Kiem tra MA_NV da ton tai trong Dic1 chua?
If Not Dic1.exists(Thang8(R, 1)) Then
K1 = K1 + 1
Dic1.Add Thang8(R, 1), K1
Res(K1, 1) = Thang8(R, 1) 'MA_NV
Res(K1, 2) = Thang8(R, 2) 'TEN_NV
Res(K1, 3) = Thang8(R, 6) 'Total
Else
Res(Dic1.Item(Thang8(R, 1)), 3) = Res(Dic1.Item(Thang8(R, 1)), 3) + Thang8(R, 6) 'Total
End If
Next R
'Chay vong lap theo chieu thu nhat cua mang Ky truoc
For R = 1 To UBound(Kytruoc, 1)
'Kiem tra MA_NV da ton tai trong Dic2 chua?
If Not Dic2.exists(Kytruoc(R, 1)) Then
K2 = K2 + 1
Dic2.Add Kytruoc(R, 1), K2
Kytruoc(K2, 1) = Kytruoc(R, 1) 'MA_NV
Kytruoc(K2, 2) = Kytruoc(R, 2) 'TEN_NV
Kytruoc(K2, 3) = Kytruoc(R, 3) 'KHO_KYTRUOC
Kytruoc(K2, 4) = Kytruoc(R, 4) 'KY_TRUOC
Else
Kytruoc(Dic2.Item(Kytruoc(R, 1)), 3) = Kytruoc(Dic2.Item(Kytruoc(R, 1)), 3) & ", " & Kytruoc(R, 3) 'KHO_KYTRUOC
Kytruoc(Dic2.Item(Kytruoc(R, 1)), 4) = Kytruoc(Dic2.Item(Kytruoc(R, 1)), 4) + Kytruoc(R, 4) 'KY_TRUOC
End If
Next R
'Chay vong lap de kiem tra phan tu mang Ky truoc co nam trong mang Res hay khong?
For R = 1 To K2
I = Dic1.Item(Kytruoc(R, 1))
'--> I > 0 --> MA_NV o mang Ky truoc co nam trong mang Res
If I Then
Res(I, 4) = Kytruoc(R, 4) 'KY_TRUOC
Res(I, 5) = Kytruoc(R, 3) 'KHO_KYTRUOC
Res(I, 6) = Kytruoc(R, 4) / Res(I, 3) 'SO_SANH
End If
Next R
With Sheet1
'Them dong tieu de
.Range("A20") = "MA_NV"
.Range("B20") = "TEN_NV"
.Range("C20") = "Total"
.Range("D20") = "KY_TRUOC"
.Range("E20") = "KHO_KYTRUOC"
.Range("F20") = "SO_SANH"
'Format du lieu cac cot ket qua
.Range("A21").Resize(K1).NumberFormat = "@"
.Range("B21").Resize(K1, 2).NumberFormat = "0,000"
.Range("F21").Resize(K1).NumberFormat = "0%"
'Dien ket qua ra bang tinh
.Range("A21").Resize(K1, 6) = Res
'Sort lai ket qua theo MA_NV
.Range("A20").Resize(K1 + 1, 6).Sort key1:=.Range("A20"), order1:=xlAscending, Header:=xlYes
End With
'Giai phong bo nho
Set Dic1 = Nothing: Set Dic2 = Nothing
Application.ScreenUpdating = True
MsgBox "Done", vbInformation, "GPE"
End Sub
