hoahuongduong1986
Thành viên thường trực
- Tham gia
- 14/11/18
- Bài viết
- 346
- Được thích
- 40
Dear Các Anh Chị,
Em thấy Scripting.Dictionary rất hay và đã dành time tìm hiểu các code mà các anh chị trên diễn đàn trợ giúp mọi người. Nhưng nói thật em dốt quá, đọc mãi em chưa hiểu ý nghĩa các đoạn Code chỉ hiểu láng máng rất ít mặc dù dùng nó chỉ có một số cái như add.dic, check tồn tại, Key, exists....nhưng khi vào một bài cụ thể thì lại không hiểu nổi. Nay em paste một Code này khá điển hình nhờ các anh chị và các bạn dành time diễn dải ý nghĩa các đoạn chính của Code được không ạ ? Kỳ thực rất muốn học để tự làm mà thấy khó quá ạ. Em cảm ơn ạ.
Sub Locgomsolieu()
.....
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
With ThisWorkbook.Worksheets("DATA")
LastR = .Cells(.Rows.Count, 1).End(xlUp).Row
Contents = .Range("a2:c" & LastR).Value
End With
For r = 1 To UBound(Contents, 1)
If dic.Exists(Contents(r, 1)) Then
Set dic2 = dic.Item(Contents(r, 1))
If dic2.Exists(Contents(r, 2)) Then
dic2.Item(Contents(r, 2)) = dic2.Item(Contents(r, 2)) + Contents(r, 3)
Else
dic2.Add Contents(r, 2), Contents(r, 3)
End If
Else
Set dic2 = CreateObject("Scripting.Dictionary")
dic2.CompareMode = vbTextCompare
dic2.Add Contents(r, 2), Contents(r, 3)
dic.Add Contents(r, 1), dic2
End If
Next
Worksheets.Add
[a1:b1].Value = Array("Code", "Product - Qty")
ParentKeys = dic.Keys
[a2].Resize(UBound(ParentKeys) + 1, 1).Value = Application.Transpose(ParentKeys)
For r = 0 To UBound(ParentKeys)
Set dic2 = dic.Item(ParentKeys(r))
ChildKeys = dic2.Keys
WriteStr = ""
For r2 = 0 To dic2.Count - 1
WriteStr = WriteStr & Chr(10) & ChildKeys(r2) & " - " & Format(dic2.Item(ChildKeys(r2)), "#,###") & " Trd"
Next
WriteStr = Mid(WriteStr, 2)
Cells(r + 2, 2) = WriteStr
Next
[a1].Sort Key1:=[a1], Order1:=xlAscending, Header:=xlYes
With [b:b]
.ColumnWidth = 40
.WrapText = True
End With
Columns.AutoFit
Rows.AutoFit
Set dic2 = Nothing
Set dic = Nothing
MsgBox "Done"
End Sub
Em thấy Scripting.Dictionary rất hay và đã dành time tìm hiểu các code mà các anh chị trên diễn đàn trợ giúp mọi người. Nhưng nói thật em dốt quá, đọc mãi em chưa hiểu ý nghĩa các đoạn Code chỉ hiểu láng máng rất ít mặc dù dùng nó chỉ có một số cái như add.dic, check tồn tại, Key, exists....nhưng khi vào một bài cụ thể thì lại không hiểu nổi. Nay em paste một Code này khá điển hình nhờ các anh chị và các bạn dành time diễn dải ý nghĩa các đoạn chính của Code được không ạ ? Kỳ thực rất muốn học để tự làm mà thấy khó quá ạ. Em cảm ơn ạ.
Sub Locgomsolieu()
.....
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = vbTextCompare
With ThisWorkbook.Worksheets("DATA")
LastR = .Cells(.Rows.Count, 1).End(xlUp).Row
Contents = .Range("a2:c" & LastR).Value
End With
For r = 1 To UBound(Contents, 1)
If dic.Exists(Contents(r, 1)) Then
Set dic2 = dic.Item(Contents(r, 1))
If dic2.Exists(Contents(r, 2)) Then
dic2.Item(Contents(r, 2)) = dic2.Item(Contents(r, 2)) + Contents(r, 3)
Else
dic2.Add Contents(r, 2), Contents(r, 3)
End If
Else
Set dic2 = CreateObject("Scripting.Dictionary")
dic2.CompareMode = vbTextCompare
dic2.Add Contents(r, 2), Contents(r, 3)
dic.Add Contents(r, 1), dic2
End If
Next
Worksheets.Add
[a1:b1].Value = Array("Code", "Product - Qty")
ParentKeys = dic.Keys
[a2].Resize(UBound(ParentKeys) + 1, 1).Value = Application.Transpose(ParentKeys)
For r = 0 To UBound(ParentKeys)
Set dic2 = dic.Item(ParentKeys(r))
ChildKeys = dic2.Keys
WriteStr = ""
For r2 = 0 To dic2.Count - 1
WriteStr = WriteStr & Chr(10) & ChildKeys(r2) & " - " & Format(dic2.Item(ChildKeys(r2)), "#,###") & " Trd"
Next
WriteStr = Mid(WriteStr, 2)
Cells(r + 2, 2) = WriteStr
Next
[a1].Sort Key1:=[a1], Order1:=xlAscending, Header:=xlYes
With [b:b]
.ColumnWidth = 40
.WrapText = True
End With
Columns.AutoFit
Rows.AutoFit
Set dic2 = Nothing
Set dic = Nothing
MsgBox "Done"
End Sub
