VBA'nın Sözlük Yapısı Var mı?

VBA'nın sözlük yapısı var mı? Anahtar <> değer dizisini beğendiniz mi?

Evet.

MS Komut Dosyası çalışma zamanı ('Microsoft Komut Dosyası Çalışma Zamanı') için bir başvuru ayarlayın. @ Regjo'nun yorumuna göre Araçlar-> Referanslar'a gidin ve 'Microsoft Komut Dosyası Çalıştırma Zamanı' kutusunu işaretleyin.

Aşağıdaki kodu kullanarak bir sözlük örneği oluşturun:

Set dict = CreateObject("Scripting.Dictionary")

veya

Dim dict As New Scripting.Dictionary 

Kullanım örneği:

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

Sözlüğü, Nothingkullanmayı bitirdiğinizde ayarlamayı unutmayın .

Set dict = Nothing 

VBA'nın toplama nesnesi vardır:

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

CollectionNesne gerçekleştirdiği hızlı yüzden bir karma kullanarak anahtar tabanlı aramaları.

Contains()Belirli bir koleksiyonun anahtar içerip içermediğini kontrol etmek için bir işlev kullanabilirsiniz :

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

Edit 24 Haziran 2015 : Contains()@TWiStErRob sayesinde daha kısa teşekkürler.

Edit 25 Eylül 2015 : Err.Clear()@scipilot sayesinde eklendi.

VBA'nın sözlükte dahili bir uygulaması yoktur, ancak VBA'dan hala MS Scripting Runtime Library'deki sözlük nesnesini kullanabilirsiniz.

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

Oluşma sıklığını içeren yararlı bir sözlük örneği.

Döngünün dışında:

Dim dict As New Scripting.dictionary
Dim MyVar as String

Döngü içinde:

'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

Frekansı kontrol etmek için:

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

Kapalı Bina cjrh cevabı , biz (ben etiketleri kullanarak sevmiyorum) bir hayır etiketler gerektiren fonksiyonu içerir inşa edebilirsiniz.

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

Bir projem için, Collectiondaha çok bir gibi davranmak için bir dizi yardımcı fonksiyon yazdım Dictionary. Yine de özyinelemeli koleksiyonlara izin verir. Key'in her zaman önce geldiğini fark edeceksiniz çünkü zorunlu ve uygulamamda daha mantıklıydı. Ben de sadece Stringanahtar kullandım . İsterseniz geri değiştirebilirsiniz.

Ayarlamak

Eski değerlerin üzerine yazacağı için bunu yeniden adlandırdım.

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

Almak

errEğer kullanarak nesneleri geçerdi çünkü şeyler nesneler içindir setolmadan ve değişkenleri. Sanırım bunun bir nesne olup olmadığını kontrol edebiliyorsun, ama zamana karşı basıldım.

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

Vardır

Bu yazının nedeni ...

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

Kaldırmak

Varsa atmaz. Sadece kaldırıldığından emin olur.

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

Anahtarlar

Bir dizi anahtar alın.

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

Komut dosyası çalıştırma zamanı sözlüğünde, gelişmiş aşamalarda tasarımınızı bozabilecek bir hata var gibi görünüyor.

Sözlük değeri bir diziyse, dizide yer alan öğelerin değerlerini sözlüğe başvuru yoluyla güncelleyemezsiniz.

Evet. For VB6 , VBA (Excel) ve VB.NET

Herhangi bir nedenle, Excel'inize ek özellikler yükleyemiyorsanız veya istemiyorsanız, en azından basit sorunlar için dizileri de kullanabilirsiniz. WhatIsCapital olarak ülkenin adını yazıyorsunuz ve fonksiyon size sermayesini geri getiriyor.

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üm diğerleri, Dictionary sınıfının scripting.runtime sürümünün kullanımından daha önce bahsetmiştir. Bu DLL'i kullanamıyorsanız, bu sürümü de kullanabilirsiniz, sadece kodunuza ekleyin.

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

Microsoft'un sürümü ile aynıdır.