VBA มีโครงสร้างพจนานุกรมหรือไม่

VBA มีโครงสร้างพจนานุกรมหรือไม่ เช่นเดียวกับคีย์ <> อาร์เรย์ค่าหรือไม่

ใช่.

ตั้งค่าการอ้างอิงถึง MS Scripting runtime ('Microsoft Scripting Runtime') ตามความคิดเห็นของ @ regjo ให้ไปที่เครื่องมือ -> การอ้างอิงและทำเครื่องหมายในช่องสำหรับ 'Microsoft Scripting Runtime'

สร้างตัวอย่างพจนานุกรมโดยใช้รหัสด้านล่าง:

Set dict = CreateObject("Scripting.Dictionary")

หรือ

Dim dict As New Scripting.Dictionary 

ตัวอย่างการใช้งาน:

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

อย่าลืมตั้งค่าพจนานุกรมเป็นNothingเมื่อคุณใช้งานเสร็จแล้ว

Set dict = Nothing 

VBA มีวัตถุการรวบรวม:

    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")

Collectionวัตถุดำเนินการค้นหาที่สำคัญโดยใช้กัญชาเพื่อให้มันได้อย่างรวดเร็ว

คุณสามารถใช้Contains()ฟังก์ชั่นเพื่อตรวจสอบว่ามีคอลเลกชันที่มีรหัส:

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

แก้ไข 24 มิถุนายน 2558 : สั้นลงContains()ด้วย @TWiStErRob

แก้ไข 25 กันยายน 2558 : เพิ่มErr.Clear()ด้วย @scipilot

VBA ไม่มีการนำพจนานุกรมไปใช้ภายใน แต่จาก VBA คุณยังสามารถใช้วัตถุพจนานุกรมจาก MS Scripting Runtime Library ได้

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

ตัวอย่างพจนานุกรมเพิ่มเติมที่มีประโยชน์สำหรับการเก็บความถี่ของการเกิดขึ้น

นอกวง:

Dim dict As New Scripting.dictionary
Dim MyVar as String

ภายในลูป:

'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

วิธีตรวจสอบความถี่:

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

อาคารปิดคำตอบ cjrh ของเราสามารถสร้างประกอบด้วยฟังก์ชั่นต้องไม่มีป้ายกำกับ (ฉันทำไม่ได้เช่นการใช้ฉลาก)

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

สำหรับโครงการของฉันฉันเขียนชุดของฟังก์ชั่นผู้ช่วยที่จะทำให้การประพฤติมากขึ้นเช่นCollection Dictionaryมันยังอนุญาตให้เรียกใช้ซ้ำได้ คุณจะสังเกตเห็นว่าคีย์มาก่อนเสมอเพราะเป็นข้อบังคับและเหมาะสมกว่าในการนำไปใช้ของฉัน ฉันยังใช้Stringกุญแจเท่านั้น คุณสามารถเปลี่ยนกลับได้หากต้องการ

ชุด

ฉันเปลี่ยนชื่อสิ่งนี้เป็นชุดเพราะมันจะเขียนทับค่าเก่า

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

ได้รับ

errสิ่งที่เป็นวัตถุเนื่องจากคุณจะผ่านวัตถุที่ใช้setและตัวแปรโดยไม่ต้อง ฉันคิดว่าคุณสามารถตรวจสอบได้ว่ามันเป็นวัตถุหรือไม่ แต่ฉันถูกกดให้เวลา

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

มี

สาเหตุของการโพสต์นี้ ...

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

ลบ

ไม่โยนหากไม่มีอยู่ แค่ทำให้แน่ใจว่ามันถูกลบ

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

คีย์

รับกุญแจมากมาย

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

พจนานุกรมรันไทม์ของสคริปต์ดูเหมือนจะมีข้อบกพร่องที่สามารถทำลายการออกแบบของคุณในขั้นตอนขั้นสูง

หากค่าพจนานุกรมเป็นอาร์เรย์คุณไม่สามารถอัปเดตค่าองค์ประกอบที่มีอยู่ในอาร์เรย์ผ่านการอ้างอิงไปยังพจนานุกรม

ใช่. สำหรับVB6 , VBA (Excel) และVB.NET

ถ้าด้วยเหตุผลใดก็ตามคุณไม่สามารถติดตั้งฟีเจอร์เพิ่มเติมลงใน Excel หรือไม่ต้องการคุณสามารถใช้อาร์เรย์ได้เช่นกันอย่างน้อยก็สำหรับปัญหาง่ายๆ ในฐานะที่เป็น WhatIsCapital คุณใส่ชื่อของประเทศและฟังก์ชั่นคืนทุนให้คุณ

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

คนอื่น ๆ ทั้งหมดได้กล่าวถึงการใช้งานเวอร์ชัน scripting.runtime ของคลาส Dictionary แล้ว หากคุณไม่สามารถใช้ DLL นี้คุณยังสามารถใช้เวอร์ชันนี้เพียงเพิ่มลงในรหัสของคุณ

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

มันเหมือนกับรุ่นของ Microsoft