VBA có cấu trúc từ điển không?

VBA có cấu trúc từ điển không? Thích khóa <> mảng giá trị?

Đúng.

Đặt tham chiếu đến thời gian chạy MS Scripting ('Microsoft Scripting Runtime'). Theo nhận xét của @ regjo, hãy chuyển đến Công cụ-> Tài liệu tham khảo và đánh dấu vào ô cho 'Microsoft Scripting Runtime'.

Tạo một ví dụ từ điển bằng cách sử dụng mã dưới đây:

Set dict = CreateObject("Scripting.Dictionary")

hoặc là

Dim dict As New Scripting.Dictionary 

Ví dụ sử dụng:

If Not dict.Exists(key) Then 
    dict.Add key, value
End If 

Đừng quên đặt từ điển Nothingkhi bạn sử dụng xong.

Set dict = Nothing 

VBA có đối tượng bộ sưu tập:

    Dim c As Collection
    Set c = New Collection
    c.Add "Data1", "Key1"
    c.Add "Data2", "Key2"
    c.Add "Data3", "Key3"
    'Insert data via key into cell A1
    Range("A1").Value = c.Item("Key2")

Đối Collectiontượng thực hiện tra cứu dựa trên khóa bằng cách sử dụng hàm băm để nhanh chóng.

Bạn có thể sử dụng một Contains()chức năng để kiểm tra xem một bộ sưu tập cụ thể có chứa khóa hay không:

Public Function Contains(col As Collection, key As Variant) As Boolean
    On Error Resume Next
    col(key) ' Just try it. If it fails, Err.Number will be nonzero.
    Contains = (Err.Number = 0)
    Err.Clear
End Function

Chỉnh sửa ngày 24 tháng 6 năm 2015 : Ngắn hơn Contains()nhờ @TWiStErRob.

Chỉnh sửa ngày 25 tháng 9 năm 2015 : Đã thêm Err.Clear()nhờ @scipilot.

VBA không có triển khai nội bộ từ điển, nhưng từ VBA bạn vẫn có thể sử dụng đối tượng từ điển từ Thư viện thời gian chạy MS Scripting.

Dim d
Set d = CreateObject("Scripting.Dictionary")
d.Add "a", "aaa"
d.Add "b", "bbb"
d.Add "c", "ccc"

If d.Exists("c") Then
    MsgBox d("c")
End If

Một ví dụ từ điển bổ sung hữu ích cho việc chứa tần suất xuất hiện.

Bên ngoài vòng lặp:

Dim dict As New Scripting.dictionary
Dim MyVar as String

Trong một vòng lặp:

'dictionary
If dict.Exists(MyVar) Then
    dict.Item(MyVar) = dict.Item(MyVar) + 1 'increment
Else
    dict.Item(MyVar) = 1 'set as 1st occurence
End If

Để kiểm tra tần suất:

Dim i As Integer
For i = 0 To dict.Count - 1 ' lower index 0 (instead of 1)
    Debug.Print dict.Items(i) & " " & dict.Keys(i)
Next i

Xây dựng câu trả lời của cjrh , chúng ta có thể xây dựng hàm Chứa không yêu cầu nhãn (Tôi không thích sử dụng nhãn).

Public Function Contains(Col As Collection, Key As String) As Boolean
    Contains = True
    On Error Resume Next
        err.Clear
        Col (Key)
        If err.Number <> 0 Then
            Contains = False
            err.Clear
        End If
    On Error GoTo 0
End Function

Đối với một dự án của tôi, tôi đã viết một tập hợp các hàm trợ giúp để thực hiện một Collectionhành vi giống như a Dictionary. Nó vẫn cho phép các bộ sưu tập đệ quy. Bạn sẽ nhận thấy Key luôn xuất hiện đầu tiên vì nó là bắt buộc và có ý nghĩa hơn trong việc triển khai của tôi. Tôi cũng chỉ sử dụng Stringchìa khóa. Bạn có thể thay đổi nó trở lại nếu bạn muốn.

Bộ

Tôi đã đổi tên này để đặt vì nó sẽ ghi đè lên các giá trị cũ.

Private Sub cSet(ByRef Col As Collection, Key As String, Item As Variant)
    If (cHas(Col, Key)) Then Col.Remove Key
    Col.Add Array(Key, Item), Key
End Sub

Được

Các errcông cụ dành cho các đối tượng vì bạn sẽ chuyển các đối tượng sử dụng setvà các biến không có. Tôi nghĩ rằng bạn chỉ có thể kiểm tra nếu nó là một đối tượng, nhưng tôi đã bị ép thời gian.

Private Function cGet(ByRef Col As Collection, Key As String) As Variant
    If Not cHas(Col, Key) Then Exit Function
    On Error Resume Next
        err.Clear
        Set cGet = Col(Key)(1)
        If err.Number = 13 Then
            err.Clear
            cGet = Col(Key)(1)
        End If
    On Error GoTo 0
    If err.Number <> 0 Then Call err.raise(err.Number, err.Source, err.Description, err.HelpFile, err.HelpContext)
End Function

Có

Lý do cho bài viết này ...

Public Function cHas(Col As Collection, Key As String) As Boolean
    cHas = True
    On Error Resume Next
        err.Clear
        Col (Key)
        If err.Number <> 0 Then
            cHas = False
            err.Clear
        End If
    On Error GoTo 0
End Function

Tẩy

Không ném nếu nó không tồn tại. Chỉ cần chắc chắn rằng nó được gỡ bỏ.

Private Sub cRemove(ByRef Col As Collection, Key As String)
    If cHas(Col, Key) Then Col.Remove Key
End Sub

Chìa khóa

Lấy một mảng các phím.

Private Function cKeys(ByRef Col As Collection) As String()
    Dim Initialized As Boolean
    Dim Keys() As String

    For Each Item In Col
        If Not Initialized Then
            ReDim Preserve Keys(0)
            Keys(UBound(Keys)) = Item(0)
            Initialized = True
        Else
            ReDim Preserve Keys(UBound(Keys) + 1)
            Keys(UBound(Keys)) = Item(0)
        End If
    Next Item

    cKeys = Keys
End Function

Từ điển thời gian chạy kịch bản dường như có một lỗi có thể làm hỏng thiết kế của bạn ở các giai đoạn nâng cao.

Nếu giá trị từ điển là một mảng, bạn không thể cập nhật giá trị của các phần tử có trong mảng thông qua tham chiếu đến từ điển.

Đúng. Đối với VB6 , VBA (Excel) và VB.NET

Nếu vì bất kỳ lý do gì, bạn không thể cài đặt các tính năng bổ sung cho Excel của mình hoặc không muốn, bạn cũng có thể sử dụng các mảng, ít nhất là cho các sự cố đơn giản. Như WhatIsCapital, bạn đặt tên quốc gia và chức năng trả lại cho bạn vốn của quốc gia đó.

Sub arrays()
Dim WhatIsCapital As String, Country As Array, Capital As Array, Answer As String

WhatIsCapital = "Sweden"

Country = Array("UK", "Sweden", "Germany", "France")
Capital = Array("London", "Stockholm", "Berlin", "Paris")

For i = 0 To 10
    If WhatIsCapital = Country(i) Then Answer = Capital(i)
Next i

Debug.Print Answer

End Sub

Tất cả những người khác đã đề cập đến việc sử dụng phiên bản scripting.r Yoon của lớp Dictionary. Nếu bạn không thể sử dụng DLL này, bạn cũng có thể sử dụng phiên bản này, chỉ cần thêm nó vào mã của bạn.

https://github.com/VBA-tools/VBA-Dixi/blob/master/Dixi.cls

Nó giống hệt với phiên bản của Microsoft.