Chỉ là cập nhật lại dữ liệu, bạn gán cái Sub này cho cái nút "Mu" của bạn nhé.
Public Sub MuMuMu()
Dim Rng As Range, CLL As Range, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Get data")
Set Rng = .Range(.[A15], .[A65536].End(xlUp))
For Each CLL In Rng
If Not Dic.Exists(CLL.Value) Then Dic.Add CLL.Value, CLL.Offset(, 3).Value
Next CLL
.Range("A15:D100").ClearContents
End With
With Sheets("Report")
Set Rng = .Range(.[B7], .[B65536].End(xlUp))
For Each CLL In Rng
If Dic.Exists(CLL.Value) Then CLL.Offset(, 2).Value = Dic.Item(CLL.Value)
Next CLL
End With
Set Dic = Nothing
MsgBox "XONG.", , "GIAIPHAPEXCEL"
End SubNếu vậy thì thay Sub trên thành cái này:
Public Sub MuMuMu()
Dim Rng As Range, CLL As Range, Dic As Object, Arr(), K As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Get data")
Set Rng = .Range(.[D15], .[D65536].End(xlUp))
ReDim Arr(1 To Rng.Rows.Count, 1 To 2)
For Each CLL In Rng
If Not Dic.Exists(CLL.Value) Then
K = K + 1
Dic.Add CLL.Value, K
Arr(K, 1) = CLL.Offset(, -3).Value
Arr(K, 2) = CLL.Offset(, -2).Value
End If
Next CLL
.Range("A15:D100").ClearContents
End With
With Sheets("Report")
Set Rng = .Range(.[D7], .[D65536].End(xlUp))
For Each CLL In Rng
If Dic.Exists(CLL.Value) Then
CLL.Offset(, -2).Value = Arr(Dic.Item(CLL.Value), 1)
CLL.Offset(, -1).Value = Arr(Dic.Item(CLL.Value), 2)
End If
Next CLL
End With
Set Dic = Nothing
MsgBox "XONG.", , "GIAIPHAPEXCEL"
End SubCái này tôi chưa giải quyết vì chẳng hiểu cái nào theo cái nào, bạn tự làm chuyện này bằng thủ công trước xem sao.
1/ Xem lại file này
