VBATools

W VBA wyróżniamy 2 programowalne kolekcje: zwykłe i słownikowe. Poniżej opisuje jak się w nich odnaleźć oraz jak wykorzystać ich parametry.

Kolekcja zwykła ma jeden wymiar i jej użycie jest podobne do obiektów w kontrolkach ActiveX – Wczesne wiązanie:

Sub PrzykladKolekcji()
    Dim mojaKolekcja As Collection
    Set mojaKolekcja = New Collection

    'Dodawanie elementów do kolekcji
    mojaKolekcja.Add "Jabłko"
    mojaKolekcja.Add "Banan"
    mojaKolekcja.Add "Pomarańcza"

    'Iterowanie przez kolekcję
    Dim owoc As Variant, info As String, i As Integer
    For Each owoc In mojaKolekcja
        i = i + 1
        info = info & i & " " & owoc & vbCr
    Next owoc
    MsgBox info
End Sub

Sub UsunElementKolekcji()
    Dim mojaKolekcja As Collection
    Set mojaKolekcja = New Collection

    'Dodawanie elementów do kolekcji
    mojaKolekcja.Add "Jabłko"
    mojaKolekcja.Add "Banan"
    mojaKolekcja.Add "Pomarańcza"

    'Usuwanie drugiego elementu
    mojaKolekcja.Remove 2

    'Iterowanie przez kolekcję
    Dim owoc As Variant, info As String, i As Integer
    For Each owoc In mojaKolekcja
        i = i + 1
        info = info & i & " " & owoc & vbCr
    Next owoc
    MsgBox info
End Sub

Słowniki mają 2 wymiary, pierwszy klucze (string), drugi (string, integer, double, boolean, przyjmie tablicę – ale jej nie zwróci) – Późne wiązanie. Zaletą Słownika jest możliwość użycia parametru .Exists dla kluczy:

Sub PrzykladSlownika()
    Dim mojSlownik As Object
    Set mojSlownik = CreateObject("Scripting.Dictionary")

    'Dodawanie elementów do słownika
    mojSlownik.Add "Jabłko", 3
    mojSlownik.Add "Banan", 5
    mojSlownik.Add "Pomarańcza", 2

    'Iterowanie przez słownik
    Dim klucz As Variant, info As String, i As Integer
    For Each klucz In mojSlownik.Keys
        i = i + 1
        info = info & i & " " & klucz & ": " & mojSlownik(klucz) & vbCr
    Next klucz
    MsgBox info
End Sub

Sub SprawdzUsunSlownik()
    Dim mojSlownik As Object
    Set mojSlownik = CreateObject("Scripting.Dictionary")

    'Dodawanie elementów do słownika
    mojSlownik.Add "Jabłko", 3
    mojSlownik.Add "Banan", 5
    mojSlownik.Add "Pomarańcza", 2

    'Sprawdzanie, czy klucz istnieje
    If mojSlownik.Exists("Pomarańcza") Then '<------
        MsgBox "Pomarańcza istnieje w słowniku."
    End If

    'Usuwanie elementu
    mojSlownik.Remove "Pomarańcza"

    'Iterowanie przez słownik
    Dim klucz As Variant, info As String, i As Integer
    For Each klucz In mojSlownik.Keys
        i = i + 1
        info = info & i & " " & klucz & ": " & mojSlownik(klucz) & vbCr
    Next klucz
    MsgBox info
End Sub

Sub SprawdzUsunSlownik2()
    Dim mojSlownik As Object
    Set mojSlownik = CreateObject("Scripting.Dictionary")

    'Dodawanie elementów do słownika
    mojSlownik.Add "Jabłko", 3
    mojSlownik.Add "Banan", 5
    mojSlownik.Add "Pomarańcza", 2
    
    Dim ilosc: ilosc = 5
    
    Dim klucz As Variant
    Dim kluczDoUsuniecia As Variant
    kluczDoUsuniecia = Null

   For Each klucz In mojSlownik.Keys
        If mojSlownik(klucz) = ilosc Then '<------
            kluczDoUsuniecia = klucz
            MsgBox "Ilość " & ilosc & " istnieje w słowniku i jest nią: " & klucz
            Exit For
        End If
    Next klucz

    'Usunięcie klucza, jeśli został znaleziony
    If Not IsNull(kluczDoUsuniecia) Then
        mojSlownik.Remove kluczDoUsuniecia
    End If

    'Iterowanie przez słownik
    Dim info As String, i As Integer
    For Each klucz In mojSlownik.Keys
        i = i + 1
        info = info & i & " " & klucz & ": " & mojSlownik(klucz) & vbCr
    Next klucz
    MsgBox info
End Sub


Sub PrzykladSlownika3()
    Dim mojSlownik As Object
    Set mojSlownik = CreateObject("Scripting.Dictionary")

    'Dodawanie różnych typów danych
    mojSlownik.Add "String", "Tekst"
    mojSlownik.Add "Integer", 123
    mojSlownik.Add "Double", 123.45
    mojSlownik.Add "Boolean", True
    mojSlownik.Add "Array", Array(1, 2, 3) 'przyjmie ale nie zwróci

    'Iterowanie przez słownik
    Dim klucz As Variant
    For Each klucz In mojSlownik.Keys
        MsgBox klucz & ": " & mojSlownik(klucz) '!!!
    Next klucz
End Sub

Kolekcjami też nazywamy kontroli, których parametry posiadają parametr .add() Są nimi np ComboBox czy ListBox. Co interesujące to kontrolka z CC1 ListView1 posiada opcję .Sorted, której wykorzystanie tylko do załadowania danych pobrania już posortowanych działa szybciej niż np funkcja bąbelkowa. Oto przykład:

Sub posortuj()
Dim x&, lista(): lista = Array("b", "a", "c", "g", "m") 'jakaś tablica
'ale może być zwykły string z przecinkami pocięty splitem do tablicy
With UserForm1.ListView1 'osadzona w formie kontrolka
  For x = 0 To UBound(lista) 'pętla po tablicy 
      .ListItems.Add Text:=lista(x) 'dodanie danych do kontrolki
  Next
  .Sorted = True 'parametr sortujący
  Dim el, lista2$
  For Each el In .ListItems 'pętla po kontrolce
      lista2 = lista2 & el & "," 'budujemy nowa listę
  Next
  .ListItems.Clear 'czyścimy aby następnym razem nie mieć dubli
End With
Debug.Print Mid(lista2, 1, Len(lista2) - 1) 'posortowany wynik w immediate
End Sub

Jest to panaceum przed używaniem dość niewydajnego sortowania bąbelkowego. Zastanów się czy nie wykorzystać tej kontrolki tylko do tego celu podczas ładowania danych do kolekcji lub tablicy.

---

Jeśli uważasz że pokazane materiały są godne polecenia – podziel się tą wiadomością z innymi pozostawiając odnośnik to tego materiału.

(c) Shon Oskar – http://VBATools.pl
Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.