VBA Excel sử dụng Scripting Dictionary

Đánh giá lequocthai.com:

Voted: 5 Votes: 5

Your page rank:

Estimated reading time: 31 minutes

Loạt các bài viết có liên quan chuyên đề VBA:
VBA Excel Hộp thoại thông báo
VBA Excel Biến trong VBA Excel
VBA Excel sử dụng Scripting Dictionary
VBA Excel Biến trong VBA Excel
VBA Excel Workbook, worksheet
VBA Excel Range, Cells
VBA Excel Hàm trong Excel VBA
VBA Excel Events, Application Object
VBA Excel Function and Sub Excel VBA
VBA Excel Array Mảng trong Excel VBA
VBA Excel FileSystemObject trong Excel VBA
VBA Excel Collection trong Excel VBA
VBA Excel Hashtable trong Excel VBA
VBA Excel Stack trong Excel VBA
VBA Excel Queue trong Excel VBA
VBA Excel SortedList Excel VBA
VBA Excel ArrayList Excel VBA
VBA Excel Ví dụ về Scripting Dictionary
Sách VBA Excel 2016 power programming with vba (pdf)

Giải thích và Hướng dẫn cách sử dụng thư viện VBA Excel Scripting Dictionary thông qua các ví dụ. Đây là một thư viện (library) VBA Excel rất hay và cực kỳ quan trọng ứng dụng rất nhiều trong thực tế giải quyết hầu như các phép tính qui về phép duy nhất. Mình sẽ tải thêm các tài liệu liên quan đến thư viện VBA Excel quan trọng này trong các bài viết tiếp theo…

Introduction

Perhaps more familiar to developers who primarily use VBScript than to developers who tend to work only with Microsoft Office and Visual Basic for Applications (VBA), the Dictionary is a powerful and versatile class, and is useful for many programming tasks.

While VBA’s native Collection class offers functionality that is in many respects similar to the Dictionary, the Dictionary class offers many additional benefits. Thus, depending on the exact functionality required for your VBA procedures, the Dictionary class may offer a compelling alternative to the more usual Collection. Indeed, even if the Dictionary’s additional functionality is not relevant to your project, a Dictionary may offer a performance advantage over a Collection.

This article provides:

An overview of the Dictionary class and its properties and methods;

A comparison between the Dictionary and the VBA Collection;

An overview of early binding versus late binding;

Four illustrative example for using the Dictionary class;

Common errors and pitfalls (i.e., ‘gotchas) encountered in programming with the Dictionary class; and

A brief analysis of relative processing speed between the Dictionary and Collection classes

Note: While the intended audience for this article is VBA developers, Visual Basic 6 (VB6) developers can certainly make use of the information here to implement Dictionaries in their VB6 projects. Further please note that the processing speed benchmarking in the final section of this article may not necessarily apply to VB6.

What Is a Dictionary?

Part of the Microsoft Scripting Runtime (scrrun.dll) library, the Dictionary class allows you to create objects holding an arbitrary number of items, with each item identified by a unique key. A Dictionary object can hold items of any data type (including other objects, such as other Dictionaries). A Dictionary’s keys can also be any data type except for arrays, although in practice they are almost always either strings or Integer/Long values. A single Dictionary object can store items of a mix different data types, and use keys of a mix of different data types.

Procedures that create a Dictionary can then:

Add new items to the Dictionary;

Remove items from the Dictionary;

Retrieve items from the Dictionary by referring to their associated key values;

Change the item associated with a particular key;

Retrieve the set of all keys currently in use;

Retrieve the count of keys currently in use; and

Change a key value, if needed.

Dictionaries are often compared to associative arrays, (sometimes also called maps, hashes, and/or hashtables) such as are found in languages such as Perl, JavaScript, C++, Python. etc.

A Dictionary is often used to store items of a similar nature. For example, consider the following list:

Employee   Date
---------------------
Sonja      2008-06-13
Sonja      2008-03-28
Franklyn   2010-03-21
Adita      2009-05-03
Adita      2010-12-04
Tommy      2006-11-24
Sonja      2007-09-06
Tommy      2010-08-16
Kayin      2009-05-12
Adita      2008-06-18

Suppose that your procedure may have to determine the earliest date associated with each employee. In this case, you could:
Create a Dictionary; For each distinct employee found, add an item (the date), and associate that date to an employee by using that employee’s name as the key;and As you work down the list, compare the date stored in the Dictionary for the current employee to the date on the line being read; and If the date on the current line is earlier than the date already stored for that key (i.e., the employee’s name), replace that stored date with the date from the current line.
(This exercise receives a full treatment in section Example #4: Retrieving Keys as Well as Items below.)

How a Dictionary Differs from a Collection

VBA developers will recognize a resemblance to the Collection class. The Collection class is native to the VBA library, and as such is fully integrated into the language. Thus, no special steps are required to use a Collection object.

Like a Dictionary, when you create a Collection you can then:
Add an arbitrary number of items to it, of any data type (like Dictionaries, this can include objects, as well as other Collections); Remove items from it; Retrieve items from it; and Return a count of items in the Collection.
However, Collections and Dictionaries have the following differences:
For Dictionaries, keys are mandatory and always unique to that Dictionary. In a Collection, while keys must be unique, they are also optional. In a Dictionary, an item can only be returned in reference to its key. In a Collection, and item can be returned in reference to its key, or in reference to its index value (i.e., ordinal position within the Collection, starting with 1). With a Dictionary, the key can take any data type; for string keys, by default a Dictionary is case sensitive, but by changing the CompareMode property it can be made case insensitive. In a Collection, keys are always strings, and always case insensitive. (See Example #2: Distinct Values with Case-Sensitive Keys) With a Dictionary, there is an Exists method to test for the existence of a particular key (and thus of the existence of the item associated with that key). Collections have no similar test; instead, you must attempt to retrieve a value from the Collection, and handle the resulting error if the key is not found (see the entry for the Exists method in section Dictionary Properties and Methods below). A Dictionary’s items and keys are always accessible and retrievable to the developer. A Collection’s items are accessible and retrievable, but its keys are not. Thus, for any operation in which retrieval of the keys is as important as retrieval of the items associated with those keys, a Dictionary object will enable a cleaner implementation than a Collection will. The Dictionary’s Item property is read/write, and thus it allows you to change the item associated with a particular key. A Collection’s Item property is read-only, and so you cannot reassign the item associated with a specified key: you must instead remove that item from the Collection, and then add in the new item. A Dictionary allows you to change a particular key value. (This is distinct from changing the value associated with a particular key.) A Collection will not allow you to do this; the nearest you could come is to remove the item using the former key value, and then to add the item back using the new key value. A Dictionary allows you to remove all items in a single step without destroying the Dictionary itself. With a Collection, you would have to either remove each item in turn, or destroy and then recreate the Collection object. Both Dictionaries and Collections support enumeration via For…Each…Next. However, while for a Collection this enumerates the items, for a Dictionary this will enumerate the keys. Thus, to use For…Each…Next to enumerate the items in a Dictionary:

For Each x In MyDictionary
    MsgBox MyDictionary.Item(x)
Next

A Dictionary supports implicit adding of an item using the Item property. With Collections, items must be explicitly added.
For relatively simple needs, such as identifying only the distinct items in a list, there is no advantage to using a Dictionary from a feature functionality perspective. However, if you must:
Retrieve keys as well as the items associated with those keys; Handle case-sensitive keys; and/or Be able to accommodate changes in items and/or keys then using a Dictionary object offers a compelling alternative to a Collection.

However, even for relatively simple needs, a Dictionary may offer a significant performance advantage, as suggested by the analysis at the end of this article.

Finally, if there is any possibility that your code will have to be ported to VBScript, you may want to consider using a Dictionary instead of a Collection: Collections do not exist in VBScript, so any code using Collections would have to have them converted to Dictionaries anyway.

Early Binding or Late Binding

Because the Dictionary class is not part of the VBA library, to use Dictionaries in your VBA projects you must either use early binding or late binding.

With early binding, you explicitly add a reference to the Microsoft Scripting Runtime library, which then allows you free access to the classes, constants, properties, methods, etc. defined in that library. For example, with early binding, you can declare and create your Dictionary this way:

Dim MyDictionary As Scripting.Dictionary
Set MyDictionary = New Scripting.Dictionary

Early binding also enables Intellisense, or auto-completion, as you type your code, and projects using early binding will usually have faster performance than projects using late binding.

To add the reference to your VBA project, go to the VB Editor, and select Tools –> References from the menu. Select Microsoft Scripting Runtime from the list of installed libraries, and click OK.

With late binding, you do not set an explicit reference to an external library, and thus when declaring your variables you would use the more generic Object type, and to instantiate a class from that library you would have to use CreateObject:

Dim MyDictionary As Object
Set MyDictionary = CreateObject("Scripting.Dictionary")

Developers typically use late binding when there is a possibility that the version of an external library on the development computer may be different from the version(s) installed on the various end-user computers; in many cases the VBA runtime engine will gracefully manage the difference with early binding, but late binding tends to be more robust in that regard.

That said, even when the finished product will use late binding to enhance potential multi-version support, developers will often enable early binding during the development process to gain access to Intellisense, and then convert the code to late binding when preparing the code for release to end users.

Dictionary Properties and Methods

The Dictionary class has four properties and six methods, as discussed below.

Add method

The Add method adds an item to the Dictionary, and associates that item with a key:

MyDictionary.Add Key, Item

The item can be anything: any data type, an object (including another Dictionary), or even an array. The key can be any data type, but cannot be an array.

The key must be unique; if you attempt to add an item using a duplicate key, you will get a runtime error.

By default, keys are case sensitive; to change this, let the CompareMode equal 1.

CompareMode property

The CompareMode indicates whether the Dictionary will be case-sensitive with respect to key strings. The default value is zero, which is case sensitive; use 1 to make the Dictionary case insensitive. Because these values match those of certain built-in VBA constants, you can also use:

MyDictionary.CompareMode = vbBinaryCompare 'case sensitive
MyDictionary.CompareMode = vbTextCompare 'case insensitive

Thus, here the Dictionary will see the two prospective keys as distinct:

With MyDictionary
    .CompareMode = vbBinaryCompare
    .Add "foo", "lower"
    .Add "FOO", "UPPER"
End With

while if the CompareMode is equal to 1, the Dictionary would see the two key values as being the same, and thus generate an error.

Count property

The Count property returns a simple count of the items currently in the Dictionary. If there are no items, then it returns zero.

MsgBox "There are " & MyDictionary.Count & " items"

Exists method

The Exists method checks for the existence of a specified key in the Dictionary, and returns boolean True if that key exists and False if not. For example, this snippet tests for existence of a key before adding a new item to the Dictionary:

With MyDictionary
    If Not .Exists(SomeKey) Then .Add SomeKey, SomeValue
End With

The Collection has no analogous method to check for existence of a specified key. To do this, you must attempt to retrieve an item from the Collection using that key, and trap any error resulting from the key no existing:

On Error Resume Next
x = MyCollection("foo")
If Err = 0 Then
    MsgBox x
Else
    Err.Clear
    MsgBox "There is no value associated with 'foo'"
End If
On Error GoTo 0

Item property

The Item property retrieves or sets an item associated with an indicated key:

With MyDictionary
    .Item("SomeKey") = "foo"
    MsgBox "The value for 'SomeKey' is '" & .Item("SomeKey")

If you use the Item property to attempt to set an item for a non-existent key, the Dictionary will implicitly add that item along with the indicated key. Also, if you attempt to retrieve an item associated with a non-existent key, the Dictionary will add a blank item, associated with that key. Thus, using the Item property with a non-existent key will not generate an error.

Items method

The Items method returns a zero-based (even if you use a module declaration of Option Base 1), one-dimensional array of the various items stored in the Dictionary.

' Returns a concatenated list of the Items:
 
MyArray = MyDictionary.Items
MsgBox Join(MyArray, ";")

There is no guarantee that the order of items in the array will match the order in which you added those items to the Dictionary.

Key property

The Key property is write-only; use it to change the value of an existing key:

MyDictionary.Key("SomeKey") = "SomeOtherKey"

The new key value must be unique to the Dictionary, and the original key you are replacing must actually exist in the Dictionary. If either of these are false, a runtime error occurs.

Keys method

The Keys method returns a zero-based (even if you use a module declaration of Option Base 1), one-dimensional array of the various keys stored in the Dictionary.

' Returns a concatenated list of the keys:
 
MyArray = MyDictionary.Keys
MsgBox Join(MyArray, ";")

There is no guarantee that the order of keys in the array will match the order in which you added those keys to the Dictionary.

Remove method

The Remove method removes the item associated with the specified key from the Dictionary, as well as that key.

MyDictionary.Remove "SomeKey"

If the specified key does not exist, an error results.

RemoveAll method

The RemoveAll method “clears” the Dictionary, by removing all items from it, along with their associated keys.

MyDictionary.RemoveAll

RemoveAll does not destroy the Dictionary object.

Example #1: Finding Distinct Values

In this example, suppose you have a list of 100 names, and you have to pick the distinct entries from that list and write them to your worksheet. The first few lines are as shown below:

There are many ways to do that; for example, one could use a PivotTable or the Advanced Filter to generate a list of unique values. However, in this example we will focus on techniques using a Collection and a Dictionary in VBA code. Please refer to the sample file and source code below:

Example-1.xls

Scripting Dictionary Example 1

Sub FindDistinct()
    
    ' Uses late binding
    
    Dim arr As Variant
    Dim Counter As Long
    Dim coll As Collection
    Dim dic As Object
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    With ThisWorkbook.Worksheets("Data")
        
        ' Clear existing results, if applicable
        
        .Range("b1").Resize(1, .Columns.Count - 1).EntireColumn.Delete
        
        ' Transfer contents of Column A to array for processing
        
        arr = .Range("a2", .Cells(.Rows.Count, "a")).Value
        
        ' Create a Collection
        
        Set coll = New Collection
        
        ' Loop through array and try to add each item in turn to the Collection.  Adding an item
        ' where the key already exists generates an error; On Error Resume Next ignores the error
        ' (and thus the duplicate item does not get added to the Collection)
        
        On Error Resume Next
        For Counter = 1 To UBound(arr, 1)
            coll.Add arr(Counter, 1), arr(Counter, 1)
        Next
        On Error GoTo 0
        
        ' Write results to the worksheet and destroy Collection
        
        .Range("c1") = "Collection"
        For Counter = 1 To coll.Count
            .Cells(Counter + 1, "c") = coll(Counter)
        Next
        Set coll = Nothing
        .Range("c1").Sort Key1:=.Range("c1"), Order1:=xlAscending, Header:=xlYes
        
        ' Create Dictionary object and loop through array of values.  For each value, treat it as
        ' both an item and a key, and set the item value using that key.  Where the key already
        ' existed, it will simply overwrite the existing item (albeit with the same value); where
        ' the key did not already exist, it will create the item/key pair.  CompareMode set to
        ' make Dictionary case insensitive.
        
        Set dic = CreateObject("Scripting.Dictionary")
        dic.CompareMode = vbTextCompare
        For Counter = 1 To UBound(arr, 1)
            dic.Item(arr(Counter, 1)) = arr(Counter, 1)
        Next
        
        ' Write results to worksheet.  First, create an array of all items (we could also have used
        ' the keys here, as they are the same), then write the transposed array to the worksheet (to
        ' force the values down a column instead of across a row)
        
        .Range("e1") = "Dictionary"
        arr = dic.Items
        .Range("e2").Resize(dic.Count, 1).Value = Application.Transpose(arr)
        Set dic = Nothing
        .Range("e1").Sort Key1:=.Range("e1"), Order1:=xlAscending, Header:=xlYes
        
        ' Resize columns as needed
        
        .Columns.AutoFit
    End With
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
    MsgBox "Done"
    
End Sub

For both the Collection and the Dictionary, we dumped the values we must analyze into an array, and then looped through the array. In adding items, with a Collection, we have no way to know whether the associated key already exists, so the only recourse is to turn on error handling, try to add every value, and rely on the error handling to allow us to ignore the errors.

With the Dictionary, we could also have used the Add method, and used error handling to evade the errors resulting when we try to add an item using a duplicate key:

' Original code for adding to Dictionary:
 
        For Counter = 1 To UBound(arr, 1)
            dic.Item(arr(Counter, 1)) = arr(Counter, 1)
        Next
 
' Alternate code for adding to Dictionary:
 
        On Error Resume Next
        For Counter = 1 To UBound(arr, 1)
            dic.Add arr(Counter, 1), arr(Counter, 1)
        Next
        On Error GoTo 0

We could also have tested first for the existence of the key:

' Original code for adding to Dictionary:
 
        For Counter = 1 To UBound(arr, 1)
            dic.Item(arr(Counter, 1)) = arr(Counter, 1)
        Next
 
' Alternate code for adding to Dictionary:
 
        On Error Resume Next
        For Counter = 1 To UBound(arr, 1)
            If Not dic.Exists(arr(Counter, 1)) Then dic.Add arr(Counter, 1), arr(Counter, 1)
        Next
        On Error GoTo 0

Based on my testing, the “Exists” approach is slightly faster than the “Item” approach, and both are significantly faster than the “Add” approach. (Please see Performance: Dictionary vs. Collection for more details.)

After running the code, we see the sorted results using a Collection and a Dictionary, and we can see that the results are identical:

Example #2: Distinct Values with Case-Sensitive Keys

In this second example, instead of employee names, suppose that the names listed in Column A of the attached sample file are system user names, and further suppose that these user names are case sensitive. Thus, the user names “Lulu”, “lulu”, and “LULU” would all represent different users. (This is not all that unusual. Indeed, Experts Exchange user names are case sensitive: Netminder is our esteemed Senior Admin, while netminder is an entirely different user.)

The first few lines are as shown below; notice that the entries on Rows 3 and 8 should be treated as being different users:

For the full list, and to test this yourself, please download this example file:

Example-2.xls

Because we need a case sensitive treatment of the keys, we cannot conveniently use a Collection: Collections are always case insensitive with respect to keys. We could manipulate the key values being passed to the Collection. For example, we could precede any upper case character in the key with a token unlikely to actually appear in the string, but given that a Dictionary can easily be made case sensitive or case insensitive, it is not worth the effort.

Indeed, for this example, there is no easy way to do this except by using a Dictionary in VBA code: since alternate techniques such as the Advanced Filter and PivotTables are case insensitive, ther will not be useful for this task.

By making two small adjustment to the source code used in Example 1, we can return the distinct values to the worksheet

Scripting Dictionary Example 2

Sub FindDistinctCaseSensitive()
    
    ' Uses late binding
    
    Dim arr As Variant
    Dim Counter As Long
    Dim dic As Object
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    
    With ThisWorkbook.Worksheets("Data")
        
        ' Clear existing results, if applicable
        
        .Range("b1").Resize(1, .Columns.Count - 1).EntireColumn.Delete
        
        ' Transfer contents of Column A to array for processing
        
        arr = .Range("a2", .Cells(.Rows.Count, "a")).Value
        
        ' Create Dictionary object and loop through array of values.  For each value, treat it as
        ' both an item and a key, and set the item value using that key.  Where the key already
        ' existed, it will simply overwrite the existing item (albeit with the same value); where
        ' the key did not already exist, it will create the item/key pair.  CompareMode set to
        ' make Dictionary case insensitive.
        
        Set dic = CreateObject("Scripting.Dictionary")
        dic.CompareMode = vbBinaryCompare
        For Counter = 1 To UBound(arr, 1)
            dic.Item(arr(Counter, 1)) = arr(Counter, 1)
        Next
        
        ' Write results to worksheet.  First, create an array of all items (we could also have used
        ' the keys here, as they are the same), then write the transposed array to the worksheet (to
        ' force the values down a column instead of across a row)
        
        .Range("e1") = "Dictionary"
        arr = dic.Items
        .Range("e2").Resize(dic.Count, 1).Value = Application.Transpose(arr)
        Set dic = Nothing
        .Range("e1").Sort Key1:=.Range("e1"), Order1:=xlAscending, Header:=xlYes
        
        ' Resize columns as needed
        
        .Columns.AutoFit
    End With
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
    MsgBox "Done"
    
End Sub

The procedure above uses a different value for CompareMode than the procedure for Example 1, and it does not include any of the code associated with the Collection approach, since using a Collection is simply impractical for this problem.

After running the procedure FindDistinctCaseSensitive, we see the following results written to the worksheet:

Example #3: Hierarchy of Distinct Values Across Two Columns (“Dictionary of Dictionaries”)

This example.
The user had data similar to the sample below:

For the full list, or to follow along on your own, please download this file:

Example-3.xls

For these data, the user wanted to: Extract the distinct values in the Code column; Extract the distinct Product values associated with each code; Extract the sums of the Quantity column for each Code/Product combination; and Write one row of output for each distinct Code, showing the concatenated Product values and the summed Quantities as a concatenated list

To do all of this, I used a “Dictionary of Dictionaries” approach:
A “parent” Dictionary had the distinct Code values as keys, and each item under those keys was a “child” Dictionary For the “children” Dictionaries, each key was a distinct Product value that appeared with the parent Code, and each item was a running sum of the quantity for that Code – Product combination

Scripting Dictionary Example 3

Sub MakeTheList()
    
    Dim dic As Object
    Dim dic2 As Object
    Dim Contents As Variant
    Dim ParentKeys As Variant
    Dim ChildKeys As Variant
    Dim r As Long, r2 As Long
    Dim LastR As Long
    Dim WriteStr As String
    
    ' Create "parent" Dictionary.  Each key in the parent Dictionary will be a disntict
    ' Code value, and each item will be a "child" dictionary.  For these "children"
    ' Dictionaries, each key will be a distinct Product value, and each item will be the
    ' sum of the Quantity column for that Code - Product combination
    
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    
    ' Dump contents of worksheet into array
    
    With ThisWorkbook.Worksheets("Data")
        LastR = .Cells(.Rows.Count, 1).End(xlUp).Row
        Contents = .Range("a2:c" & LastR).Value
    End With
        
    ' Loop through the array
    
    For r = 1 To UBound(Contents, 1)
        
        ' If the current code matches a key in the parent Dictionary, then set dic2 equal
        ' to the "child" Dictionary for that key
        
        If dic.Exists(Contents(r, 1)) Then
            Set dic2 = dic.Item(Contents(r, 1))
            
            ' If the current Product matches a key in the child Dictionary, then set the
            ' item for that key to the value of the item now plus the value of the current
            ' Quantity
            
            If dic2.Exists(Contents(r, 2)) Then
                dic2.Item(Contents(r, 2)) = dic2.Item(Contents(r, 2)) + Contents(r, 3)
            
            ' If the current Product does not match a key in the child Dictionary, then set
            ' add the key, with item being the amount of the current Quantity
            
            Else
                dic2.Add Contents(r, 2), Contents(r, 3)
            End If
        
        ' If the current code does not match a key in the parent Dictionary, then instantiate
        ' dic2 as a new Dictionary, and add an item (Quantity) using the current Product as
        ' the Key.  Then, add that child Dictionary as an item in the parent Dictionary, using
        ' the current Code as the key
        
        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
    
    ' Add a new worksheet for the results
    
    Worksheets.Add
    [a1:b1].Value = Array("Code", "Product - Qty")
    
    ' Dump the keys of the parent Dictionary in an array
    
    ParentKeys = dic.Keys
    
    ' Write the parent Dictionary's keys (i.e., the distinct Code values) to the worksheet
    
    [a2].Resize(UBound(ParentKeys) + 1, 1).Value = Application.Transpose(ParentKeys)
    
    ' Loop through the parent keys and retrieve each child Dictionary in turn
    
    For r = 0 To UBound(ParentKeys)
        Set dic2 = dic.Item(ParentKeys(r))
        
        ' Dump keys of child Dictionary into array and initialize WriteStr variable (which will
        ' hold concatenated products and summed Quantities
        
        ChildKeys = dic2.Keys
        WriteStr = ""
        
        ' Loop through child keys and retrieve summed Quantity value for that key.  Build both
        ' of these into the WriteStr variable.  Recall that Excel uses linefeed (ANSI 10) for
        ' in-cell line breaks
        
        For r2 = 0 To dic2.Count - 1
            WriteStr = WriteStr & Chr(10) & ChildKeys(r2) & " - " & dic2.Item(ChildKeys(r2))
        Next
        
        ' Trim leading linefeed
        
        WriteStr = Mid(WriteStr, 2)
        
        ' Write concatenated list to worksheet
        
        Cells(r + 2, 2) = WriteStr
    Next
    
    ' Sort and format return values
    
    [a1].Sort Key1:=[a1], Order1:=xlAscending, Header:=xlYes
    With [b:b]
        .ColumnWidth = 40
        .WrapText = True
    End With
    Columns.AutoFit
    Rows.AutoFit
    
    ' Destroy object variables
    
    Set dic2 = Nothing
    Set dic = Nothing
    
    MsgBox "Done"
    
End Sub

Running that procedure MakeTheList above yields the following results, which match the original requirement:

Note: Normally I would of course recommend a PivotTable for this sort of analysis, and indeed in the original question the Experts, myself included, advocated for that approach. When the Asker insisted on this particular result, I thus resorted to the “Dictionary of Dictionaries” technique.

Example #4: Retrieving Keys as Well as Items

In this final example, we have a list of employees, along with a column of dates for each employee. Think of these dates as the dates our employees completed a sale of a particular type of product:

For the full list, and to follow along on your own, please download:

Example-4.xls

Suppose that you need to find the earliest date associated with each employee. (Yes, one could use a PivotTable to get this information quite easily, but stay with me for the sake of example.)

In this example, we must track two separate data elements: the distinct employee names, and the earliest dates appearing with each employee name. A Dictionary is ideally suited for this analysis:
Because both items and keys are accessible in a Dictionary, we can use a single object to track both data elements; and A Dictionary allows you to reassign items associated with a specified key, thus enabling convenient update of the item values (i.e., the dates) as we analyze the data.
We could use a Collection, but this would be much less convenient than using a Dictionary:
Because a Collection’s keys are not retrievable, we would need two separate collections to track both data elements (one to track employee names, the other to track the dates, with both Collections using employee name as its key); and Because items in a Collection cannot be easily updated, as we find an earlier date for a given employee than what is already stored, we must first remove that item from the “dates” Collection, and then add an item for the earlier date.
The procedure MakeTheList (source code below) illustrates both approaches:

Scripting Dictionary Example 4

Sub MakeTheList()
    
    ' uses late binding
    
    Dim Contents As Variant
    Dim r As Long
    Dim dic As Object
    Dim TestEmp As String
    Dim TestDate As Date
    Dim Keys As Variant
    Dim EmpColl As Collection
    Dim DateColl As Collection
    
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    
    With ThisWorkbook.Worksheets("Data")
        
        ' Dump raw data into an array
        
        .Range("c1").Resize(1, .Columns.Count - 2).EntireColumn.Delete
        Contents = .Range("a2", .Cells(.Rows.Count, "B").End(xlUp)).Value
        
        ' Set up Collections.  Because we need to track two data elements (employee name and date),
        ' and because we cannot retrieve the keys from a Collection, we must set up two Collections:
        ' one to track employee names and one to track dates (both using employee name as the key)
        
        Set EmpColl = New Collection
        Set DateColl = New Collection
        
        ' Turn on error handling.  Collections have no explicit existence test, so the only way to
        ' know if an item exists is to try to add it or retrieve it, and then trap the error if it
        ' does not exist
        
        On Error Resume Next
        
        ' Loop through the array
        
        For r = 1 To UBound(Contents, 1)
            TestEmp = Contents(r, 1)
            TestDate = Contents(r, 2)
            
            ' Attempt to add the employee.  If employee already exists in Collection, this will
            ' throw a handled error
            
            EmpColl.Add TestEmp, TestEmp
            If Err = 0 Then
                
                ' No error = new employee; add the test date also
                
                DateColl.Add TestDate, TestEmp
            Else
                
                ' Error = existing employee.  Check the TestDate and see if it is earlier than the
                ' date we already have for the employee.  If TestDate is earlier, remove the current
                ' date from the Collection and add the newer, earlier date (items within a Collection
                ' cannot be reassigned)
                
                Err.Clear
                If TestDate < DateColl(TestEmp) Then
                    DateColl.Remove TestEmp
                    DateColl.Add TestDate, TestEmp
                End If
            End If
        Next
        On Error GoTo 0
        
        ' Write the results to the worksheet
        
        .Range("d1:e1").Value = Array("Collection" & Chr(10) & "Employee", "Date")
        For r = 1 To EmpColl.Count
            .Cells(r + 1, "d") = EmpColl(r)
            .Cells(r + 1, "e") = DateColl(EmpColl(r))
        Next
        
        ' Create Dictionary and loop through array
        
        Set dic = CreateObject("Scripting.Dictionary")
        For r = 1 To UBound(Contents, 1)
            TestEmp = Contents(r, 1)
            TestDate = Contents(r, 2)
            
            ' Test to see if current employee already exists
            
            If dic.Exists(TestEmp) Then
                
                ' Employee exists; update date if applicable
                
                If TestDate < dic.Item(TestEmp) Then dic.Item(TestEmp) = TestDate
            Else
                
                ' Employee does not exist, so add employee and date
                
                dic.Add TestEmp, TestDate
            End If
        Next
        
        ' Write results to worksheet
        
        Keys = dic.Keys
        .Range("g1:h1").Value = Array("Dictionary" & Chr(10) & "Employee", "Date")
        .Range("g2").Resize(dic.Count, 1).Value = Application.Transpose(Keys)
        For r = 0 To UBound(Keys)
            .Cells(r + 2, "h") = dic.Item(Keys(r))
        Next
        
        ' Format worksheet
        
        .Range("d:d").WrapText = True
        .Range("g:g").WrapText = True
        .Range("e:e").NumberFormat = "yyyy-mm-dd"
        .Range("h:h").NumberFormat = "yyyy-mm-dd"
        .Range("d:d").EntireColumn.ColumnWidth = 20
        .Range("g:g").EntireColumn.ColumnWidth = 20
        .Rows.AutoFit
        .Columns.AutoFit
        .Range("d1").Sort Key1:=.Range("d1"), Order1:=xlAscending, Header:=xlYes
        .Range("g1").Sort Key1:=.Range("g1"), Order1:=xlAscending, Header:=xlYes
    End With
    
    ' Destroy objects
    
    Set EmpColl = Nothing
    Set DateColl = Nothing
    Set dic = Nothing
    
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    
    MsgBox "Done"
    
End Sub

Both approaches yield identical results:

Dictionary ‘Gotchas’

In using the Dictionary class, please be cognizant of the following common errors.

Case Sensitivity

By default, when a Dictionary evaluates a key that is a string, it is case sensitive. Thus, by default, “key” <> “KEY”. That can cause unexpected results if you do not care about case and need the Dictionary to parse key string in a case insensitive fashion.

To address this, get into the habit of always explicitly setting the value of the CompareMode property, and using vbBinaryCompare (case sensitive) or vbTextCompare (case insensitive) as appropriate. (You can also use 0 and 1, respectively, but using the built-in constants makes your code more self-documenting.)

Item and the “Implicit Add”

As indicated above, trying to set the Item property with a non-existent key will implicitly add that item to the Dictionary along with that key, and trying to retrieve an item with a non-existent key will also create a new item.

While this is sometimes the behavior that you want, it can also lead to unexpected results. To guard against that, consider using Exists first to ensure that the specified key actually exists, and also make sure that your Dictionary is using an appropriate CompareMode value.
Key Data Types

If you are using a mix of data types in your prospective key values, remember that keys of different data types will be seen as unique. For example:

With MyDictionary
    .Add 1, "number"
    .Item("1") = "text"
End With

In that snippet, the first line adds a new item, with key value 1. The second line adds another value, because the number 1 is different from the string “1”.

If you want your Dictionary to see the number 1 and the string “1” as being the same, then you should convert the numeric value to a string:

With MyDictionary
    .Add CStr(1), "number"
    .Item("1") = "text"
End With

That snippet adds the item “number”, associated with the key “1”. It then reassigns the item “text” to that same key “1”.

Performance: Dictionary vs. Collection

Beyond its potential benefits in feature functionality and in enabling easier porting of code to VBScript, using the Dictionary class may offer you a significant benefit in terms of increased execution speed. The tests I performed for this analysis are not necessarily conclusive, and may only apply to VBA projects hosted in Microsoft Excel, but they do suggest that, ceteris paribus, a Dictionary is faster than a collection. Individual results will, of course, vary based on computer specifications, available resources during the test, etc.

The test is fairly simple:
In an Excel worksheet, I made 50 columns, each with 10,000 random integers. The ranges within which these numbers varied was different in each column. I then wrote a VBA procedure that identified the distinct values in each column, and wrote those distinct values underneath the analyzed values. This procedure used a Collection approach first to identify and then write the distinct values, and then three different Dictionary-based approaches to doing the same. Each approach was run 20 times in succession. For all four of these approaches, my procedure captured the start time and end time, and thus the time required for the operation. The procedure then wrote the results of each trial to a worksheet for comparison and analysis. To test the impact of early binding vs. late binding, I made two copies of the workbook, using the same test data and the same test code (differing only in how I declared and instantiated my Dictionary variable).
The results using late binding showed an impressive performance gain for the Dictionary; depending on the technique used, the Dictionary performed 34% – 46% faster than the Collection:

As expected, the results using early binding showed an even larger benefit for the Dictionary, as early binding tends to increase the performance speed for code leveraging external libraries:

In the early binding results, the Dictionary performed approximately 55% – 69% faster than the Collection.

For relatively small tasks, it is unlikely that a human would ever notice the difference between the execution speed between a Dictionary and a Collection. That said, for larger tasks, or for tasks requiring a lot of repetition, changing from a Collection to a Dictionary may yield a significant performance benefit.

If you wish to repeat these performance tests on your own, I encourage you to download the sample files below, and to examine the source code I used to perform the tests.

Benchmark-Early-Binding.xlsm
Benchmark-Late-Binding.xlsm

Dictionary and Collection

' This code is for early binding; set reference to Microsoft Scripting Runtime library
 
Option Explicit
 
Private Sub CompareObjects()
    
    ' This sub actually runs the tests
    
    Dim coll As Collection
    Dim dic As Scripting.Dictionary
    Dim Counter As Long
    Dim RowCounter As Long
    Dim ColCounter As Long
    Dim StartCollection As Date
    Dim EndCollection As Date
    Dim StartDicAdd As Date
    Dim EndDicAdd As Date
    Dim StartDicItem As Date
    Dim EndDicItem As Date
    Dim StartDicExists As Date
    Dim EndDicExists As Date
    Dim arr As Variant
    Dim Results() As Long
    Dim oRow As ListRow
    
    Const Iterations As Long = 20
    Const NumRows As Long = 10000
    Const NumCols As Long = 50
    
    With ThisWorkbook.Worksheets("Test Data")
        
        'Remove rows with distinct values written to them
 
        .Range((NumRows + 1) & ":" & .Rows.Count).Delete
        
        StartCollection = Now
    
        ' Repeat the test several times to smooth out random fluctuations
 
        For Counter = 1 To Iterations
            For ColCounter = 1 To NumCols
 
                ' Create Collection
 
                Set coll = New Collection
 
                ' Array transfer to speed up process
 
                arr = .Cells(1, ColCounter).Resize(NumRows, 1).Value
 
                ' If you attempt to add an item where the key already exists, an error results
 
                On Error Resume Next
                For RowCounter = 1 To NumRows
                    coll.Add arr(RowCounter, 1), CStr(arr(RowCounter, 1))
                Next
                On Error GoTo 0
 
                ' Build an array with the return values and write them to worksheet
 
                ReDim Results(1 To coll.Count, 1 To 1)
                For RowCounter = 1 To coll.Count
                    Results(RowCounter, 1) = coll(RowCounter)
                Next
                .Cells(NumRows + 2, ColCounter).Resize(UBound(arr, 1), 1).Value = Results
                Set coll = Nothing
            Next
        Next
        
        EndCollection = Now
        
        .Range((NumRows + 1) & ":" & .Rows.Count).Delete
        
        StartDicAdd = Now
    
        For Counter = 1 To Iterations
            For ColCounter = 1 To NumCols
 
                ' Create Dictionary
 
                Set dic = New Scripting.Dictionary
                arr = .Cells(1, ColCounter).Resize(NumRows, 1).Value
 
                ' If you attempt to add an item where the key already exists, an error results
 
                On Error Resume Next
                For RowCounter = 1 To NumRows
                    dic.Add arr(RowCounter, 1), arr(RowCounter, 1)
                Next
                On Error GoTo 0
 
                ' Put keys into an array, and write array values to worksheet
 
                arr = dic.Keys
                .Cells(NumRows + 2, ColCounter).Resize(dic.Count, 1).Value = Application.Transpose(arr)
                Set dic = Nothing
            Next
        Next
        
        EndDicAdd = Now
        
        .Range((NumRows + 1) & ":" & .Rows.Count).Delete
        
        StartDicItem = Now
    
        For Counter = 1 To Iterations
            For ColCounter = 1 To NumCols
                Set dic = New Scripting.Dictionary
                arr = .Cells(1, ColCounter).Resize(NumRows, 1).Value
 
                ' In this approach, we use the Item property's "implicit add" capability.  Within
                ' the loop, the Item property either reassigns the item to the key (albeit to same value
                ' if the key already exists, or creates a new key/item pair if not
 
                For RowCounter = 1 To NumRows
                    dic.Item(arr(RowCounter, 1)) = arr(RowCounter, 1)
                Next
                arr = dic.Keys
                .Cells(NumRows + 2, ColCounter).Resize(dic.Count, 1).Value = Application.Transpose(arr)
                Set dic = Nothing
            Next
        Next
        
        EndDicItem = Now
        
        .Range((NumRows + 1) & ":" & .Rows.Count).Delete
        
        StartDicExists = Now
    
        For Counter = 1 To Iterations
            For ColCounter = 1 To NumCols
                Set dic = New Scripting.Dictionary
                arr = .Cells(1, ColCounter).Resize(NumRows, 1).Value
 
                ' In this approach, we test for existence first; if the key does not exist, we add the item
 
                For RowCounter = 1 To NumRows
                    If Not dic.Exists(arr(RowCounter, 1)) Then
                        dic.Add arr(RowCounter, 1), arr(RowCounter, 1)
                    End If
                Next
                arr = dic.Keys
                .Cells(NumRows + 2, ColCounter).Resize(dic.Count, 1).Value = Application.Transpose(arr)
                Set dic = Nothing
            Next
        Next
        
        EndDicExists = Now
        
    End With
    
    ' For each of the four approaches, write a record to the Results worksheet
 
    With ThisWorkbook.Worksheets("Results")
        Set oRow = .ListObjects("Stats").ListRows.Add(AlwaysInsert:=True)
        oRow.Range(1, 1) = StartCollection
        oRow.Range(1, 2) = "Collection"
        oRow.Range(1, 3) = EndCollection - StartCollection
        Set oRow = .ListObjects("Stats").ListRows.Add(AlwaysInsert:=True)
        oRow.Range(1, 1) = StartCollection
        oRow.Range(1, 2) = "Dictionary Add"
        oRow.Range(1, 3) = EndDicAdd - StartDicAdd
        Set oRow = .ListObjects("Stats").ListRows.Add(AlwaysInsert:=True)
        oRow.Range(1, 1) = StartCollection
        oRow.Range(1, 2) = "Dictionary Item"
        oRow.Range(1, 3) = EndDicItem - StartDicItem
        Set oRow = .ListObjects("Stats").ListRows.Add(AlwaysInsert:=True)
        oRow.Range(1, 1) = StartCollection
        oRow.Range(1, 2) = "Dictionary Exists"
        oRow.Range(1, 3) = EndDicExists - StartDicExists
    End With
        
End Sub

Sub CompareObjectsMulti()
    
    ' Use this to run the test multiple times
 
    Dim Iterations As Long
    Dim Counter As Long
    
    On Error GoTo ErrHandler
    
    Iterations = InputBox("How many trials do you want (each can take 2-4 minutes)", "Compare", 10)
    
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    
    For Counter = 1 To Iterations
        CompareObjects
    Next
    
ErrHandler:
    
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    
    MsgBox "Done"
    
End Sub

Sub CompareObjectsSingle()
    
    ' Use this to run the test one time
 
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
    
    CompareObjects
    
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    
    MsgBox "Done"
    
End Sub

Tải file Excel các ví dụ trên:

Benchmark-Early-Binding.xlsm
Benchmark-Late-Binding.xlsm

Source: Experts-Exchange