Học Dictionary qua các ví dụ đơn giản!

[chuot0106]

Thực sự thì mình cũng chưa biết tên topic như vậy có hợp lí không(Nếu chưa hợp lí mong BQT sửa giúp), mình nêu mục đích của topic này luôn.
Bởi vì trên GPE đã có topic về vấn đề này rồi tuy nhiên các topic đó cũng chưa đi sâu lắm về "Dic" bản thân mình rất khó tiếp thu(cá nhân mình thôi). bởi vậy mình xin phép BQT được lập Topic mới này giành cho những người mới chập chững nghiên cứu về "Dic" như mình với mục đích chính như sau:
+ Mong các bạn có kinh nghiệm về "Dic" vào chia sẻ kinh nghiệm của bả n thân về việc học "Dic".
+ Các bạn có kinh nghiệm về "Dic" đưa ra các bài tập từ cơ bản đến đến nâng cao để các thành viên mới thực hành.
+ Các thành viên mới có thể đưa ra các câu hỏi cũng như bài tập liên quan để các thành viên có kinh nghiệm giúp đỡ.
Tất cả các mục đích này dựa trên tinh thần chia sẻ, giao lưu, học hỏi.
Rất mong nhận được sự chia sẻ của các bạn!

 

[chuot0106]

Em xin tự mở hàng topic của mình bằng 1 câu hỏi sau:
Ra kết quả không phải là mục đích chính mà quan trọng hơn em muốn trong code các thầy, các anh chị và các bạn giải thích cho em hiểu ý nghĩa các câu lệnh(thông qua các chú thích). Em cảm ơn!

 

[leonguyenz]

Em xin tự mở hàng topic của mình bằng 1 câu hỏi sau:
Ra kết quả không phải là mục đích chính mà quan trọng hơn em muốn trong code các thầy, các anh chị và các bạn giải thích cho em hiểu ý nghĩa các câu lệnh(thông qua các chú thích). Em cảm ơn!

Tôi tham gia trong tầm hiểu biết của tôi thôi nhé. Giải thích code tôi chèn trong file.
Còn nhiều cao thủ, mong là họ viết cặn kẽ hơn.

Sub BtDic()
Dim Dic As Object, i As Long, j As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    .[F2:G10].ClearContents
    For i = 1 To .[A2:B10].Rows.Count
        If Not Dic.Exists(.Cells(i + 1, 1).Value) Then
            j = j + 1
            Dic.Add .Cells(i + 1, 1).Value, j
            .Cells(j + 1, 6) = .Cells(i + 1, 1)
            .Cells(j + 1, 7) = .Cells(i + 1, 2)
        End If
    Next i
End With
Set Dic = Nothing
End Sub

 

[chuot0106]

Tôi tham gia trong tầm hiểu biết của tôi thôi nhé. Giải thích code tôi chèn trong file.
Còn nhiều cao thủ, mong là họ viết cặn kẽ hơn.

Sub BtDic()
Dim Dic As Object, i As Long, j As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet1
    .[F2:G10].ClearContents
    For i = 1 To .[A2:B10].Rows.Count
        If Not Dic.Exists(.Cells(i + 1, 1).Value) Then
            j = j + 1
            Dic.Add .Cells(i + 1, 1).Value, j
            .Cells(j + 1, 6) = .Cells(i + 1, 1)
            .Cells(j + 1, 7) = .Cells(i + 1, 2)
        End If
    Next i
End With
Set Dic = Nothing
End Sub

Cảm ơn Mr.Bum trước tôi nghiên cứu code của bạn đã. Có gì không hiểu tôi lại phiền tiếp!
To Mr.Bum:
Tôi đã xem code của bạn thấy rất dễ hiểu, quả thật được hướng dẫn tỉ mỉ thế này học rất nhanh. Cảm ơn Mr.Bum nhiều!

 

[chuot0106]

Lời giả của em về câu hỏi 1 em đưa ra ở #2, có tham khảo bài của Mr.Bum. Em làm trên mảng. Mong các bạn góp ý!

Option Explicit


Public Sub cauhoi1_dic()
Dim arr(), tam(), dic As Object, i As Long, j As Long
    arr = Sheet1.Range("A2:B10")
    ReDim tam(1 To UBound(arr, 1), 1 To UBound(arr, 2))
Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr, 1)
        If Not dic.exists(arr(i, 1)) Then
            j = j + 1
            dic.Add arr(i, 1), j
            tam(j, 1) = arr(i, 1)
            tam(j, 2) = arr(i, 2)
        End If
    Next i
        Sheet1.Range("F2").Resize(j, UBound(arr, 2)).Value = tam
End Sub

 

[chuot0106]

Em đưa tiếp câu hỏi 2, do em tự nghĩ ra có gì chưa hợp lí mong các bạn góp ý!
Em có 1 bảng thông kê bán hàng của các nhân viên. Giờ em muốn lập bảng thống kê xem trong ba ngày mỗi nhân viên bán được tổng bao nhiêu tiền.

P/S: Mong các bạn giỏi về "Dic" đưa ra các dạng bài tập có thể dùng "Dic" ở mức độ dễ hoặc trung bình để mình và các bạn mới học có thể tự làm. tự nghĩ ra đề hơi khó. Các bạn trải qua rồi sẽ dễ dàng hơn!

 

[chuot0106]

Câu hỏi 3: Lọc dữ liệu trùng trong nhiều cột và đưa ra kết quả ra 1 cột.

P/S: Theo em thì theo mức độ từ khó tới dễ câu này phải là câu 2, còn câu 2 thì là câu 3.

 

[chuot0106]

Không biết câu 2 có làm được bằng "Dic" không nữa? Mong các Thầy vào xem giúp, em tự bịa ra đề. Đau đầu với nó hơn 1 tiếng đồng hồ rồi mà chưa ra thuật toán. Bế tắc quá, mong các thầy cho biết là câu 2 có dùng "Dic" được không ạ? Nếu không em sẽ gỡ File xuống. Mong các thầy cho bọn em 1 số BT ở mức độ dễ và trung bình, quả thật bịa đề khó thật.

 

[chuot0106]

Em đưa tiếp câu hỏi 2, do em tự nghĩ ra có gì chưa hợp lí mong các bạn góp ý!
Em có 1 bảng thông kê bán hàng của các nhân viên. Giờ em muốn lập bảng thống kê xem trong ba ngày mỗi nhân viên bán được tổng bao nhiêu tiền.

P/S: Mong các bạn giỏi về "Dic" đưa ra các dạng bài tập có thể dùng "Dic" ở mức độ dễ hoặc trung bình để mình và các bạn mới học có thể tự làm. tự nghĩ ra đề hơi khó. Các bạn trải qua rồi sẽ dễ dàng hơn!

Bài 2, đánh lươn lẹo 1 tý vậyVẫn dùng Dic)
Dựa vào code của bài 1, lọc ra danh sách không trùng. Sau đó sử dụng công thức SumProduct thế là xong.

 

[Hau151978]

Mình thử làm câu 2, điền cột C thôi, cột B thì như câu 1 rồi. Mình cũng không biết khai báo array tmp() kiểu gì?

Sub cau2()
Dim dic As Object
Dim tmp()
Dim i As Integer
Dim s As String
Set dic = CreateObject("scripting.dictionary")
For i = 1 To 9
If dic.Exists(Cells(i + 1, 1).Text) Then
dic.Item(Cells(i + 1, 1).Text) = dic.Item(Cells(i + 1, 1).Text) + Cells(i + 1, 3).Value + Cells(i + 1, 4).Value + Cells(i + 1, 5).Value
Else
dic.Add Cells(i + 1, 1).Text, Cells(i + 1, 3).Value + Cells(i + 1, 4).Value + Cells(i + 1, 5).Value
End If
Next
tmp = dic.Keys
For i = 0 To dic.Count - 1
s = tmp(i)
Cells(15 + i, 1) = s
Cells(15 + i, 3) = dic.Item(s)
Next
Set dic = Nothing
End Sub

 

[Quang_Hải]

Em xin tự mở hàng topic của mình bằng 1 câu hỏi sau:
Ra kết quả không phải là mục đích chính mà quan trọng hơn em muốn trong code các thầy, các anh chị và các bạn giải thích cho em hiểu ý nghĩa các câu lệnh(thông qua các chú thích). Em cảm ơn!

Code cho câu 1.

Sub abc()
Dim tam(), i As Long
tam = Range([A2], [B65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(tam)
        If Not .exists(tam(i, 1)) Then
            .Add tam(i, 1), tam(i, 2)
        End If
    Next
    [F2].Resize(.Count) = Application.Transpose(.keys)
    [G2].Resize(.Count) = Application.Transpose(.items)
End With
End Sub

Và code cho câu 2

Sub abc()
Dim tam(), kq(1 To 10000, 1 To 3)
Dim i As Long, k As Long, n As Long, tong As Double
tam = Range([A2], [A65536].End(3)).Resize(, 5).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(tam)
        tong = tam(i, 3) + tam(i, 4) + tam(i, 5)
        If Not .exists(tam(i, 1)) Then
            k = k + 1
            .Add tam(i, 1), k
           kq(k, 1) = tam(i, 1)
           kq(k, 2) = tam(i, 2)
           kq(k, 3) = tong
        Else
            n = .Item(tam(i, 1))
            kq(n, 3) = kq(n, 3) + tong
        End If
    Next
End With
[L2].Resize(k, 3) = kq
End Sub

PS: Mình chỉ viết code thôi, chứ cốc có biết chú thích.

 

[chuot0106]

Mình thử làm câu 2, điền cột C thôi, cột B thì như câu 1 rồi. Mình cũng không biết khai báo array tmp() kiểu gì?

Sub cau2()
Dim dic As Object
Dim tmp()
Dim i As Integer
Dim s As String
Set dic = CreateObject("scripting.dictionary")
For i = 1 To 9
If dic.Exists(Cells(i + 1, 1).Text) Then
dic.Item(Cells(i + 1, 1).Text) = dic.Item(Cells(i + 1, 1).Text) + Cells(i + 1, 3).Value + Cells(i + 1, 4).Value + Cells(i + 1, 5).Value
Else
dic.Add Cells(i + 1, 1).Text, Cells(i + 1, 3).Value + Cells(i + 1, 4).Value + Cells(i + 1, 5).Value
End If
Next
tmp = dic.Keys
For i = 0 To dic.Count - 1
s = tmp(i)
Cells(15 + i, 1) = s
Cells(15 + i, 3) = dic.Item(s)
Next
Set dic = Nothing
End Sub

Cảm ơn bạn, kết quả bài bạn chính xác rồ! Nếu có thể bạn chú thích 1 chút về code thì sẽ tốt hơn! Mục tiêu của topic là vậy mà! Mong bạn chia sẻ!

 

[hungpecc1]

* "scripting.Dictionary" là công cụ mạnh để giải quyết bài toán có yếu tố trùng lặp : ví dụ lọc duy nhất,tổng hợp dữ liệu theo một yếu tố nào đó,...........
* Code thì đã có nhiều người viết rồi, thông thường trước câu lệnh if not dic.exists(tmp ) nên thêm một điều kiện kiểm tra chuỗi tmp có phải là ký hiệu rỗng không :

If Len(tmp) then
   If not dic.exists(tmp) then
        dic.add tmp,..
    Else
    ...........
   end if
end if

 

[chuot0106]

* "scripting.Dictionary" là công cụ mạnh để giải quyết bài toán có yếu tố trùng lặp : ví dụ lọc duy nhất,tổng hợp dữ liệu theo một yếu tố nào đó,...........
* Code thì đã có nhiều người viết rồi, thông thường trước câu lệnh if not dic.exists(tmp ) nên thêm một điều kiện kiểm tra chuỗi tmp có phải là ký hiệu rỗng không :

If Len(tmp) then
   If not dic.exists(tmp) then
        dic.add tmp,..
    Else
    ...........
   end if
end if

Nếu có thể anh có thể cho em và 1 số bạn mới học 1 bài tập đơn giản không ạ?

 

[chuot0106]

Code cho câu 1.

Sub abc()
Dim tam(), i As Long
tam = Range([A2], [B65536].End(3)).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(tam)
        If Not .exists(tam(i, 1)) Then
            .Add tam(i, 1), tam(i, 2)
        End If
    Next
    [F2].Resize(.Count) = Application.Transpose(.keys)
    [G2].Resize(.Count) = Application.Transpose(.items)
End With
End Sub

Và code cho câu 2

Sub abc()
Dim tam(), kq(1 To 10000, 1 To 3)
Dim i As Long, k As Long, n As Long, tong As Double
tam = Range([A2], [A65536].End(3)).Resize(, 5).Value
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(tam)
        tong = tam(i, 3) + tam(i, 4) + tam(i, 5)
        If Not .exists(tam(i, 1)) Then
            k = k + 1
            .Add tam(i, 1), k
           kq(k, 1) = tam(i, 1)
           kq(k, 2) = tam(i, 2)
           kq(k, 3) = tong
        Else
            n = .Item(tam(i, 1))
            kq(n, 3) = kq(n, 3) + tong
        End If
    Next
End With
[L2].Resize(k, 3) = kq
End Sub

PS: Mình chỉ viết code thôi, chứ cốc có biết chú thích.

Code của anh QuangHai thì quá Ok rồi, nhưng cách viết có vẻ hơi tắt 1 chút hay sao ấy, bởi em thấy lạ lạ. Chắc anh ngại chú thích thôi chứ sao mà anh ko biết! Mong anh chia sẻ chút kinh nghiệm! Cảm ơn anh!

 

[hungpecc1]

Nếu có thể anh có thể cho em và 1 số bạn mới học 1 bài tập đơn giản không ạ?

thì lấy luôn ví dụ là bài tập của bạn thôi :
Mình thử viết code bài 2 như sau :

Sub dem_khuya()
Dim tmpArr, item, tmp, Arr
Dim i&, Sum, n&
'On Error Resume Next
    tmpArr = [A2:E10]
    ReDim Arr(1 To UBound(tmpArr, 1), 1 To 3)
'......................................................
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(tmpArr, 1)
            tmp = tmpArr(i, 1)
            If Len(tmp) Then
                Sum = tmpArr(i, 3) + tmpArr(i, 4) + tmpArr(i, 5)
                If Not .exists(tmp) Then
                    n = n + 1
                    .Add tmp, n
                    Arr(n, 1) = tmp: Arr(n, 2) = tmpArr(i, 2): Arr(n, 3) = Sum
                Else
                    Arr(.item(tmp), 3) = Arr(.item(tmp), 3) + Sum
                End If
            End If
        Next
    End With
'...........................................................................
    [A15:C100].ClearContents
    [A15].Resize(n, 3) = Arr
End Sub

Nếu có dòng code nào khó hiểu, bạn thử ấn F8 để degbug sẽ dễ hiểu hơn !
p/s : viết code xong rồi , xem lại thấy code của mình khá giống với code của anh Quang Hải,^^ <-------- chắc là có chung một trường phái đây

 

[hungpecc1]

Nếu có thể anh có thể cho em và 1 số bạn mới học 1 bài tập đơn giản không ạ?

Nếu bạn đã nắm được cách dùng ( thuộc tính, phương thức ) của Dictionary ,mình thứ đặt ra 3 yêu cầu , bạn làm thử coi :
** Ví dụ 1 :

Vẫn dữ liệu như bài tập 2 đã gửi , yêu cầu :
* thống kê xem có bao nhiêu người tên A trong cột A1: A10 ( đưa kết quả ra hộp thoại msgbox )
** Thống kê những người có cùng Họ và tên + địa chỉ trùng nhau ,và tính tổng số lượng trong 3 ngày : ( đưa toàn bộ kết quả này vào vùng [G:J]
*** Sắp xếp kết quả của yêu cầu ** theo : Tên hoặc theo tổng số lượng giảm dần !

!

 

[siwtom]

Nếu có thể anh có thể cho em và 1 số bạn mới học 1 bài tập đơn giản không ạ?

Kiểm ta kiến thức về Dictionary
Cột A (từ A2) - Tên các thành phố, cột B (từ B2) - tên người. Cột C (từ C2) - kết quả. Nếu Azyz = Ha noi và Bxyz = "he" thì có nghĩa là anh/ chị "he" đã có lần đi du lịch Ha noi.
Hãy liệt kê (từ C2) những thành phố chưa từng đến bởi các vị (các bởi không phân biệt Nam béo hay Nam lác. Cứ Nam là coi là 1) có tên nhập vào C1.
Ví dụ với dữ liệu giả lập
Hà nội, Nga
Hà nội, Tuấn
Huế, Nga
Đà nẵng, Bình
Hà nội, Bình
Huế, Tuấn
Hải Phòng, Bình

C1 = Nga --> C2 = Đà nẵng, C3 = Hải Phòng

 

[siwtom]

p/s : viết code xong rồi , xem lại thấy code của mình khá giống với code của anh Quang Hải,^^ <-------- chắc là có chung một trường phái đây

He he. Trường phái gì. Chẳng qua là bạn mải vật lộn vã mồ hôi với bài Toán nên không để ý là anh Hải tới đứng đằng sau lưng mà thôi

 

[Hau151978]

Cảm ơn bạn, kết quả bài bạn chính xác rồ! Nếu có thể bạn chú thích 1 chút về code thì sẽ tốt hơn! Mục tiêu của topic là vậy mà! Mong bạn chia sẻ!

Trong bài Tổng quan về Dictionary của tác giả kyo có nêu 2 cách khởi tạo dic:
Cách 1: Dim dic as scripting.dictionary
Set dic = new scripting.dictionary
Cách 2: Dim dic as object
Set dic = createobject("scripting.dictionary")
Tác giả có nói cách 1 nhanh hơn còn cách 2 dễ chia sẻ hơn. Như vậy có thể một số bạn luôn dùng cách 2. Tuy nhiên cách 1 ngoài tốc độ nhanh còn có lợi điểm hỗ trợ intellisense nên dễ viết công thức, dễ gỡ rối. Theo mình khi làm bài nên theo cách 1, sau khi ra kết quả sẽ chuyển cách 2.
Để duyệt tất cả phần tử của dic, có thể dùng vòng lặp For Each Next. Mình sửa câu 2 trong bài làm của mình, phần điền cột A, C cho ngắn gọn hơn, không cần khai báo biến mảng nữa:

Sub cau2()
Dim dic As Object
Dim k
Dim i As Integer
Set dic = CreateObject("scripting.dictionary")
For i = 1 To 9
If dic.Exists(Cells(i + 1, 1).Value) Then
dic.Item(Cells(i + 1, 1).Value) = dic.Item(Cells(i + 1, 1).Value) + Cells(i + 1, 3).Value + Cells(i + 1, 4).Value + Cells(i + 1, 5).Value
Else
dic.Add Cells(i + 1, 1).Value, Cells(i + 1, 3).Value + Cells(i + 1, 4).Value + Cells(i + 1, 5).Value
End If
Next
i = 0
For Each k In dic
Cells(15 + i, 1) = k
Cells(15 + i, 3) = dic.Item(k)
i = i + 1
Next
Set dic = Nothing
End Sub