Sub LayDulieu()
Dim sArr(), tArr(), Res(), Dic As Object
Dim i As Long, ik As Long, sRow As Long, eRow As Long
Set Dic = CreateObject("scripting.dictionary")
With Sheets("DuLieu")
eRow = .Range("B1000000").End(xlUp).Row
If eRow < 4 Then Exit Sub
tArr = .Range("A4:X" & eRow).Value
End With
sRow = UBound(tArr)
ReDim Res(1 To sRow, 1 To 3)
For i = 1 To sRow
Dic.Item(tArr(i, 1) & "#" & tArr(i, 2)) = i
'Dic.Item(tArr(i, 1) & "#" & tArr(i, 24)) = i
Next i
With Sheets("BrDau")
eRow = .Range("B1000000").End(xlUp).Row
If eRow > 2 Then
sArr = .Range("B3:E" & eRow).Value
For i = 1 To UBound(sArr)
ik = Dic.Item(sArr(i, 1) & "#" & sArr(i, 3))
If ik > 0 Then Res(ik, 1) = sArr(i, 4)
Next i
End If
End With
With Sheets("BrGiua")
eRow = .Range("B1000000").End(xlUp).Row
If eRow > 2 Then
sArr = .Range("B3:E" & eRow).Value
For i = 1 To UBound(sArr)
ik = Dic.Item(sArr(i, 1) & "#" & sArr(i, 3))
If ik > 0 Then Res(ik, 2) = sArr(i, 4)
Next i
End If
End With
With Sheets("BrCuoi")
eRow = .Range("B1000000").End(xlUp).Row
If eRow > 2 Then
sArr = .Range("B3:E" & eRow).Value
For i = 1 To UBound(sArr)
ik = Dic.Item(sArr(i, 1) & "#" & sArr(i, 3))
If ik > 0 Then Res(ik, 3) = sArr(i, 4)
Next i
End If
End With
With Sheets("DuLieu")
.Range("C4:E4").Resize(sRow) = Res
End With
'****
ReDim Res(1 To sRow, 1 To 16)
With Sheets("SoBinh")
eRow = .Range("B1000000").End(xlUp).Row
If eRow > 2 Then
sArr = .Range("B3:E" & eRow).Value
For i = 1 To UBound(sArr)
ik = Dic.Item(sArr(i, 1) & "#" & sArr(i, 3))
If ik > 0 Then Res(ik, sArr(i, 4)) = sArr(i, 2)
Next i
End If
End With
With Sheets("DuLieu")
.Range("H4:W4").Resize(sRow) = Res
End With
'****
ReDim Res(1 To sRow, 1 To 6)
With Sheets("DichDu")
eRow = .Range("B1000000").End(xlUp).Row
If eRow > 2 Then
sArr = .Range("B3:G" & eRow).Value
For i = 1 To UBound(sArr)
ik = Dic.Item(sArr(i, 1) & "#" & sArr(i, 3))
If ik > 0 Then
Res(ik, 2 * sArr(i, 6) - 1) = sArr(i, 4)
Res(ik, 2 * sArr(i, 6)) = sArr(i, 5)
End If
Next i
End If
End With
With Sheets("DuLieu")
.Range("Y4:AD4").Resize(sRow) = Res
End With
End Sub
