Tổng quan về Scripting.Dictionary

Status
Không mở trả lời sau này.

kyo

Nguyễn Khắc Duy
Thành viên BQT
Administrator
Tham gia ngày
4 Tháng sáu 2006
Bài viết
901
Được thích
2,627
Điểm
910
Với những ai yêu thích Excel nói chung và yêu thích VBA nói riêng thì chắc hẳn cũng đã biết qua các khái niệm về mảng, về công thức điều kiện, vòng lặp,..., những thứ rất quen thuộc mà gần như là sử dụng thường xuyên trong từng bài toán lập trình. Tuy nhiên, có lẽ sẽ rất ít người biết về Dictionary, một công cụ đầy sức mạnh xuất hiện trên VBA từ rất lâu rồi. Sẽ có nhiều người thắc mắc khi thấy các “cao thủ” trên GPE trổ tài sử dụng Dic và không hiểu gì vì những điều mới lạ vừa nhìn thấy cũng như rất ít tư liệu tiếng Việt về Dic trên GPE nói riêng và trên Internet nói chung. Do đó, kyo viết lại bài này dựa trên tư liệu tiếng Anh của Experts-exchange và trên GPE với mong muốn đóng góp ít nhiều, giúp cho các thành viên mới có được cái nhìn tổng quan hơn về Dictionary. Lẽ dĩ nhiên sẽ còn rất nhiều thiếu sót trong bài, mong được mọi người góp ý và sửa chữa.

I. Dictionary là gì?


1. Định nghĩa
Là một phần trong thư viện Microsoft Scripting Runtime (scrrun.dll), Dictonary class là một công cụ đầy sức mạnh và linh hoạt. Nó cho phép người sử dụng tạo một object với số lượng item tùy ý,và mỗi item được nhận dạng dựa trên một key duy nhất. Dic có thể nhận các dữ liệu thuộc các kiểu dữ liệu khác nhau mà thường thấy là kiểu chuỗi (string), số (integer, long,…) hay thậm chí là một sự kết hợp giữa cả hai kiểu dữ liệu.

2. Ưu điểm của Dictionary

- Có thể thêm vào số lượng item tùy ý với những kiểu dữ liệu khác nhau.
- Các item và key của Dictionary rất dễ truy xuất, sửa chữa và bổ sung.
- Dictionary cho phép bạn xóa tất cả các item tồn tại trong Dic mà không cần phải phá hủy chính nó.
- Và cuối cùng, các item chỉ có thể được gọi duy nhất bằng cách là thông qua một key mà key đó là bắt buộc và là duy nhất (không thể có 2 key trùng nhau). Điều này tạo thuận lợi cho các bài toán trích lọc danh sách duy nhất và đây cũng chính là ưu điểm lớn nhất của Dictionary.

3. Cách sử dụng Dictionary
1/ Cách khai báo
Vì Dictionary không phải là một phần của thư viện VBA, do đó, để sử dụng nó, chúng ta cần phải khai báo. Bạn có thể khai báo bằng cả hai cách sau:

Cách 1
: Để sử dụng cách 1, trước tiên bạn phải vào Tools -> References và lựa chọn Microsoft Scripting Runtime từ trên danh sách để cài đặt -> nhấn OK.


Sau đó, gõ dòng lệnh:
PHP:
Dim MyDictionary As Scripting.Dictionary 
Set MyDictionary = New Scripting.Dictionary

Cách 2
: Gõ dòng lệnh:
PHP:
Dim MyDictionary As Object 
Set MyDictionary = CreateObject("Scripting.Dictionary")
Cách 1 sẽ cho tốc độ nhanh hơn cách 2. Tuy nhiên, cách 2 lại thuận tiện hơn cách 1 khi chia sẻ file cho người sử dụng khác, do với máy tính khác nhau sẽ có nhiều người sử dụng các phiên bản khác nhau. Cách 1 chỉ phù hợp khi chính bạn sử dụng, còn cách 2 phù hợp hơn cho việc chia sẻ.

2/ Các phương thức và thuộc tính:
a. Các phương thức:

- Phương thức Add: Phương thức Add dùng để thêm item vào Dictionary.
PHP:
MyDictionary.Add Key, Item
Item có nhận dữ liệu thuộc bất kì kiểu dữ liệu gì. Key cũng nhận như item nhưng ngoại trừ kiểu dữ liệu mảng (array). Key phải là duy nhất, nếu bạn thêm item với cùng một key, bạn sẽ gặp lỗi.

- Phương thức Exists: Phương thức Exists sẽ kiểm tra xem Key có tồn tại hay không? Nếu Key tồn tại, kết quả sẽ là True và không tồn tại thì kết quả sẽ là False.

- Phương thức Items: Phương thức Items sẽ trả về giá trị mảng một chiều mà phần tử đầu tiên là phần tử 0 (dù cho bạn có sử dụng Option Base 1).
PHP:
MyArray = MyDictionary.Items 
MsgBox Join(MyArray, ";")
- Phương thức Keys: Phương thức Keys sẽ trả về giá trị mảng một chiều mà phần tử đầu tiên là phần tử 0 (dù cho bạn có sử dụng Option Base 1).
PHP:
MyArray = MyDictionary.Keys 
MsgBox Join(MyArray, ";")
- Phương thức Remove: Phương thức Remove sẽ xóa một item thông qua một Key. Nếu Key không tồn tại, bạn sẽ gặp lỗi.
PHP:
MyDictionary.Remove "SomeKey"
- Phương thức RemoveAll: Phương thức RemoveAll sẽ xóa toán bộ những gì có trong Dictionary (nhưng không xóa chính nó).
PHP:
MyDictionary.RemoveAll
b. Các thuộc tính:

- Thuộc tính CompareMode: Dictionary có thể phân biệt dạng chữ được hay không phụ thuộc vào thuộc tính CompareMode. Giá trị mặc định của thuộc tính là 0 (vbBinaryCompare) giúp phân biệt chữ hoa chữ thường trong Key, còn giá trị 1 (vbTextCompare) thì không phân biệt.
PHP:
MyDictionary.CompareMode = vbBinaryCompare  ‘phân biệt 
MyDictionary.CompareMode = vbTextCompare  'không phân biệt
Ví dụ dưới đây sẽ không gây ra lỗi, nhưng nếu CompareMode = 1 thì chắc chắn bạn sẽ gặp lỗi vì “gpe” và “GPE” là giống nhau.
PHP:
With MyDictionary
      .CompareMode = vbBinaryCompare
      .Add "gpe", "lower"
      .Add "GPE", "UPPER" 
End With
- Thuộc tính Count: Thuộc tính Count sẽ trả về giá trị số lượng item có trong Dictionary. Nếu không có item trong Dic, thuộc tính này sẽ trả về giá trị 0.

- Thuộc tính Item: Thuộc tính Item giúp truy xuất hoặc thiết lập giá trị cho một Key nào đó.
PHP:
With MyDictionary
         .Item("SomeKey") = "gpe"
         MsgBox "Giá trị của SomeKey là " & .Item("SomeKey") 
End With
Nếu bạn sử dụng thuộc tính Item để đưa một item vào một Key không tồn tại, Dictionary sẽ thêm mới Key không tồn tại đó, đồng thời cũng thêm item vào Key đó luôn. Cũng vậy, nếu bạn truy xuất một item qua một Key không tồn tại, Dictionary sẽ thêm một item rỗng vào chính Key đó. Do đó, sử dụng thuộc tính Item với một Key không tồn tại sẽ không gây ra lỗi.

- Thuộc tính Key: Thuộc tính Key được dùng để thay đổi giá trị của một Key có sẵn. Tuy nhiên, giá trị Key mới phải là giá trị duy nhất trong Dictionary cũng như giá trị Key mà bạn muốn thay đổi cũng phải tồn tại trong Dictionary. Nếu một trong hai điều kiện trên không đúng, chắc chắn lỗi sẽ xảy ra.
PHP:
MyDictionary.Key("SomeKey") = "SomeOtherKey"
3/ Một số lỗi thường gặp
a. vbBinaryCompare hay vbTextCompare

Mặc định, CompareMode = vbBinaryCompare, tức là “key” ”KEY”. Còn trong trường hợp ngược lại, “key” = “KEY”. Tuy nhiên, cũng chính từ điều này mà đã nảy sinh ra một số rắc rối không cần thiết. Vẫn có nhiều người lẫn lộn giữa vbBinaryCompare và vbTextCompare dẫn đến kết quả không ra như ý muốn. Do đó, bạn cần phải chú ý để thiết lập cho phù hợp.

b. Kiểu dữ liệu của Key

PHP:
With MyDictionary
         .Add 1, "number"
         .Item("1") = "text" 
End With
Dòng số 2, kiểu dữ liệu của Key là dạng số trong khi dòng số 3, kiểu dữ liệu của Key là dạng chuỗi dẫn đến hai Key của ví dụ trên là khác nhau. Muốn cho cả hai Key đó giống nhau cũng như là để gán lại item cho Key, tức chỉ là kiểu chuỗi chẳng hạn, bạn phải sử dụng câu lệnh .Add CStr(1), “number” thay cho dòng số 2 ở bên trên.
 
Lần chỉnh sửa cuối:

kyo

Nguyễn Khắc Duy
Thành viên BQT
Administrator
Tham gia ngày
4 Tháng sáu 2006
Bài viết
901
Được thích
2,627
Điểm
910
4/ Ví dụ tham khảo
Trích từ bài tập của chú Mỹ (ptm0412) trong chuyên đề bài tập VBA. Đây là một dạng khá thông dụng dùng để sử dụng Dic vì mục đích của nó chính là trích lọc ra giá trị duy nhất, tức giá trị “Nhân viên” dùng để biết được nhân viên đó đem lại doanh thu là bao nhiêu.


Bài giải



PHP:
Sub Cau1()
Dim Dic1 As Object, iRow As Long, i As Long
Dim Arr() As Variant, TmpArr As Variant
With Sheets("Cau1")
 .Range("E4:H10").ClearContents
  Set Dic1 = CreateObject("Scripting.Dictionary")
    TmpArr = Sheet1.Range("b2:g21").Value
    ReDim Arr(1 To UBound(TmpArr, 1), 1 To 6)
    For iRow = 1 To UBound(TmpArr, 1)
        If Not IsEmpty(TmpArr(iRow, 2)) And Not Dic1.exists(TmpArr(iRow, 2)) Then
            i = i + 1
             Dic1.Add TmpArr(iRow, 2), i
             Arr(i, 1) = TmpArr(iRow, 1)
             Arr(i, 2) = TmpArr(iRow, 2)
            If TmpArr(iRow, 3) <> "" Then
                Arr(i, 3) = TmpArr(iRow, 6)
            Else
                Arr(i, 4) = TmpArr(iRow, 6)
            End If
        Else
            If TmpArr(iRow, 3) <> "" Then
                Arr(Dic1.Item(TmpArr(iRow, 2)), 3) = Arr(Dic1.Item(TmpArr(iRow, 2)), 3) + TmpArr(iRow, 6)
            Else
                
             Arr(Dic1.Item(TmpArr(iRow, 2)), 4) = Arr(Dic1.Item(TmpArr(iRow, 2)), 4) + TmpArr(iRow, 6)
                
            End If
        End If
    Next iRow
.Range("e4").Resize(i, 4).Value = Arr
End With
End Sub

II. Một số ứng dụng trên GPE


1. Tạo dãy số ngẫu nhiên không trùng (tác giả ndu96081631)


Cú pháp hàm: =UniqueRandom(số nhỏ, số lớn, bao nhiêu số cần tạo). Có 2 cách sử dụng, hoặc là dùng trực tiếp trên cell, hoặc là sử dụng VBA. Bạn có thể tham khảo thêm tại đường link: http://www.giaiphapexcel.com/forum/showthread.php?27286-Tạo-dãy-số-ngẫu-nhiên-không-trùng


PHP:
Function UniqueRandomNum(Bottom As Long, Top As Long, Amount As Long)
  'Application.Volatile '<--- Neu muon gia tri thay doi khi bam F9
  On Error Resume Next
  If Amount > Top - Bottom + 1 Then Amount = Top - Bottom + 1
  With CreateObject("Scripting.Dictionary")
    Do
      .Add Int(Rnd() * (Top - Bottom + 1)) + Bottom, ""
    Loop Until .Count = Amount
    UniqueRandomNum = WorksheetFunction.Transpose(.Keys)
  End With
End Function

2. Lọc dữ liệu duy nhất


Ví dụ ở trên là một minh chứng cho ứng dụng này, bạn có thể đọc ví dụ trên để hiểu rõ hơn, hoặc bạn cũng có thể search trên GPE để tham khảo thêm về cách lọc dữ liệu với độ phức tạp cao hơn. Chẳng hạn dưới đây là một số đường link:3. Ứng dụng game “Quay số trúng thưởng” (tác giả minhthien321)



Các bạn có thể download file cũng như nghiên cứu các câu lệnh tại đường link này: http://www.giaiphapexcel.com/forum/showthread.php?51196-Tặng-các-bạn-file-QUAY-SỐ-TRÚNG-THƯỞNG-nhân-dịp-SN-GiaiphapExcel-Com-lần-5

4. Loại bỏ kí tự trùng (tác giả ndu96081631)


Cú pháp hàm: =StrUnique(chuỗi). Có 2 cách sử dụng, hoặc là dùng trực tiếp trên cell, hoặc là sử dụng VBA. Bạn có thể tham khảo thêm tại đường link: http://www.giaiphapexcel.com/forum/showthread.php?33739-Cách-loại-bỏ-những-kí-tự-trùng-nhau


PHP:
Function StrUnique(Text As String) As String
  Dim i As Long, Temp
  On Error Resume Next
  If InStr(Text, ",") Then
    Temp = Split(Text, ",")
    With CreateObject("Scripting.Dictionary")
      For i = 0 To UBound(Temp)
        .Add Temp(i), ""
      Next i
      StrUnique = Join(.Keys, ",")
    End With
  Else
    StrUnique = Left(Text, 1)
    For i = 1 To Len(Text)
      If InStr(StrUnique, Mid(Text, i, 1)) = 0 Then StrUnique = StrUnique & Mid(Text, i, 1)
    Next i
  End If
End Function
Trên đây chỉ là một số ứng dụng của Dictionary (lẽ dĩ nhiên ứng dụng đó phải có yếu tố giá trị duy nhất). Thực sự thì Dictionary vẫn còn rất nhiều ứng dụng trên nhiều lĩnh vực, tất cả đều phụ thuộc vào nhu cầu cũng như khả năng sáng tạo của chính bạn.

“Hãy tìm mọi cách để sử dụng item. Không chỉ ghi item đồng thời với key mà còn đọc item để sử dụng cho nhiều mục đích khác nhau. Ngoài ra, có thể sửa item để sử dụng cho lần sau, để sử dụng nhiều lần.” Và chính lời khuyên trên của chú Mỹ - “lão chết tiệt” ptm0412 cũng đã kết thúc bài viết tổng quan về Dictionary. Hy vọng bài viết tổng quan về Dictionary này sẽ giúp bạn có thêm cái nhìn tổng quan hơn cũng như giúp bạn có thêm “vũ khí” và làm ra được nhiều chương trình ứng dụng phù hợp với chính mình.
 
Lần chỉnh sửa cuối:

ptm0412

Excel Ordinary Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
9,285
Được thích
28,277
Điểm
1,910
Tuổi
57
Nơi ở
Gò Vấp
Nếu bạn sử dụng thuộc tính Item để đưa một item vào một Key không tồn tại, Dictionary sẽ thêm mới Key không tồn tại đó, đồng thời cũng thêm item vào Key đó luôn. Cũng vậy, nếu bạn truy xuất một item qua một Key không tồn tại, Dictionary sẽ thêm một item rỗng vào chính Key đó. Do đó, sử dụng thuộc tính Item với một Key không tồn tại sẽ không gây ra lỗi.
Code để kiểm tra tính xác thực của câu trên:

PHP:
Sub test()
Dim MyDict As Object, VarTest
Set MyDict = CreateObject("Scripting.Dictionary")
With MyDict
    .Item("GPE") = "Excellent"     '(Gán Item cho 1 key chưa tồn tại)'
    VarTest = .Item("Cheettit")   '(Truy xuất Item của 1 key không tồn tại)'
    MsgBox .Count
        Sheet1.[A1].Resize(.Count, 1) = Application.Transpose(.keys)
        Sheet1.[B1].Resize(.Count, 1) = Application.Transpose(.items)
End With
End Sub
Kết quả:
- Mặc dù không có câu lệnh Add nào để tạo key, nhưng MsgBox .Count cho kết quả là 2
- Key thứ nhất là "GPE", Item của nó là "Excellent"
- Key thứ 2 là "Cheettit" và Item của nó là rỗng.

|
A​
|
B​
|
1​
|GPE|Excellent|
2​
|Cheettit| |
 
Chỉnh sửa lần cuối bởi điều hành viên:

ptm0412

Excel Ordinary Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
9,285
Được thích
28,277
Điểm
1,910
Tuổi
57
Nơi ở
Gò Vấp
“Hãy tìm mọi cách để sử dụng item. Không chỉ ghi item đồng thời với key mà còn đọc item để sử dụng cho nhiều mục đích khác nhau. Ngoài ra, có thể sửa item để sử dụng cho lần sau, để sử dụng nhiều lần.” Và chính lời khuyên trên của chú Mỹ - “lão chết tiệt” ptm0412 cũng đã kết thúc bài viết tổng quan về Dictionary. Hy vọng bài viết tổng quan về Dictionary này sẽ giúp bạn có thêm cái nhìn tổng quan hơn cũng như giúp bạn có thêm “vũ khí” và làm ra được nhiều chương trình ứng dụng phù hợp với chính mình.
Đây là 1 thí dụ về việc tận dụng Item của Dictionary, sử dụng và sửa để sử dụng nhiều lần:

Trích:

Hôm nay ta không chỉ ghi Item, đọc Item để xài, mà còn sửa Item để xài lại, sử dụng Item để đếm bao nhiêu lần xuất hiện của mỗi mã trùng. Nhưng thay vì đếm bắt đầu từ 1, ta đếm từ 65 để dùng nó cho hàm Chr(), vì Chr(65) = "A".

PHP:
Sub FinalCode()
Dim SArr, RArr
Dim i As Long, n As Long, EndR As Long
Application.ScreenUpdating = False
t = Timer
EndR = [D65000].End(xlUp).Row
SArr = Range("D2:D" & EndR).Value
ReDim RArr(1 To EndR - 1, 1 To 1)

With CreateObject("Scripting.dictionary")
For i = 1 To EndR - 1
    If Not .Exists(SArr(i, 1)) Then
        .Add SArr(i, 1), 65
    Else
        .Item(SArr(i, 1)) = .Item(SArr(i, 1)) + 1
    End If
        n = .Item(SArr(i, 1))
        RArr(i, 1) = (SArr(i, 1)) & Chr(n)
Next
End With

Range("E2:E" & EndR) = RArr
Application.ScreenUpdating = True
[F1] = Timer - t
test
End Sub
Xem tại đây: http://www.giaiphapexcel.com/forum/showthread.php?59554-Các-bạn-giúp-mình-hàm-tự-tạo-tách-các-chữ-cái-họ-tên-tiếng-Việt-để-làm-mã-nhân-viên&p=370270#post370270
 

ptm0412

Excel Ordinary Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
9,285
Được thích
28,277
Điểm
1,910
Tuổi
57
Nơi ở
Gò Vấp
Item có thể nhận dữ liệu thuộc bất kì kiểu dữ liệu gì. Key cũng có thể nhận kiểu dữ liệu như item nhưng ngoại trừ kiểu dữ liệu mảng (array).
Nghĩa là Item có thể nhận giá trị mảng.

Lấy 1 bài trên GPE đã sử dụng Dictionary, http://www.giaiphapexcel.com/forum/showthread.php?59477-Lọc-dữ-liệu-theo-nhóm-bằng-VBA&p=368852#post368852, thử làm lại nhưng gán giá trị mảng cho Item:

Bài toán là liệt kê các lệnh điều động xe theo thứ tự từ trái qua phải cho mỗi xe. Giả định mỗi xe có nhiều chuyến, mỗi chuyến chỉ có 1 lệnh.

File trong bài viết đó dùng 1 mảng kết quả để lấy kết quả từ dữ liệu nguồn căn cứ vào danh sách duy nhất lọc bằng Dictionary.

Bây giờ ta bỏ mảng kết quả, chỉ dùng Dictionary với Item là mảng.
Tốc độ có thể chậm hơn, nhưng là thử nghiệm để khẳng định bài viết của Kyo.

PHP:
Sub DicItemAsArray()
Dim SArr, RArr, TmpArr, Dic1, MaxCols As Long
Dim i As Long, s As Long, EndR As Long, n As Long, Tmp As Long
t = Timer
Set Dic1 = CreateObject("Scripting.Dictionary")
With Dic1
EndR = Sheet2.[b65000].End(xlUp).Row
SArr = Sheet2.Range("A2:C" & EndR).Value
For i = 1 To EndR - 1
    If Not .Exists(SArr(i, 2)) Then            'Nếu chưa tồn tại số xe'
        s = s + 1
        .Add SArr(i, 2), Array(SArr(i, 1))    'Gán số xe vào Dictionary với Item là 1 mảng 1 phần tử'
        MaxCols = 1 
    Else                                             'Nếu đã có số xe'
        TmpArr = .Item(SArr(i, 2))
        Tmp = UBound(.Item(SArr(i, 2)))
        ReDim Preserve TmpArr(Tmp + 1)    'Tăng kích thước mảng của Item lên 1'
        TmpArr(Tmp + 1) = SArr(i, 1)          'Gán thêm 1 phần tử vào mảng Item'
        .Item(SArr(i, 2)) = TmpArr
        If MaxCols < Tmp + 1 Then MaxCols = Tmp + 1
    End If
Next
Sheet1.[A4].Resize(s, 1) = Application.Transpose(.keys)       'Gán keys của Dictionary xuống sheet'
RArr = Sheet1.[A4].Resize(s, 1).Value

'Gán từng mảng Item xuống  sheet ngang với key tương ứng'
For i = 1 To .Count
    Sheet1.Range("B" & i + 3).Resize(1, UBound(.Item(RArr(i, 1))) + 1) = .Item(RArr(i, 1))
Next
End With
Sheet1.[A1] = Timer - t
Sheet1.[A2] = MaxCols
End Sub
Trong file kèm theo có cả 2 cách để so sánh. Cách cũ nhanh gấp 4 lần, nhưng cách mới chỉ để thử nghiệm Item là 1 giá trị mảng.
 

File đính kèm

Lần chỉnh sửa cuối:

ptm0412

Excel Ordinary Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
9,285
Được thích
28,277
Điểm
1,910
Tuổi
57
Nơi ở
Gò Vấp
Thí dụ 2 về tạo Dictionary với Item là mảng

Cũng file trên nhưng làm ngược từ kết quả ra dữ liệu ban đầu:

PHP:
Sub ItemArray2()
Dim EndR As Long, nR As Long, iCount As Long
Dim Dic1, RArr, SArr
t = Timer
Set Dic1 = CreateObject("Scripting.Dictionary")
With Sheet1
    EndR = .[A65000].End(xlUp).Row
    For i = 4 To EndR
        Dic1.Add .Cells(i, 1).Value, .Cells(i, 2).Resize(1, 25).Value
    Next
    SArr = .[A4].Resize(Dic1.Count, 1).Value
End With
ReDim RArr(1 To Dic1.Count * 25, 1 To 2)

For i = 1 To Dic1.Count
    For j = 1 To 25
        If Dic1.Item(SArr(i, 1))(1, j) <> "" Then
            nR = nR + 1
            RArr(nR, 1) = SArr(i, 1)
            RArr(nR, 2) = Dic1.Item(RArr(nR, 1))(1, j)
        Else
            Exit For
        End If
    Next
Next
Sheet3.[A3].Resize(nR, 2) = RArr
Sheet3.[B1] = Timer - t
End Sub
Tốc độ so với cách khác (chỉ dùng mảng thông thường) cũng có chậm hơn.
 

File đính kèm

anhphuong

Thân Thương
Tham gia ngày
12 Tháng ba 2007
Bài viết
515
Được thích
2,588
Điểm
860

File đính kèm

Status
Không mở trả lời sau này.
Top