RSS

Afhængige ComboBoxes og arrays i klasser

Denne side viser, hvordan valget i én combobox kan styre indholdet i en anden. Den viser også, hvordan man kan have et dynamisk antal arrays i en class collection.

Du kan downloade et regneark med eksemplet. Regnearket er zip-komprimeret, og kommentarerne til koden er på engelsk.

Jeg har skrevet en del om lyksalighederne ved at bruge arrays for at behandle data i en fart, men hvad gør man, hvis man ikke ved, hvor mange arrays der er brug for? Arrays skal jo deklareres ...

Man kan putte arrays i en collection (samling), men det, man tilføjer, er en kopi af arrayet, og så vidt jeg ved, kan man ikke efterfølgende manipulere arrayet i sin collection.

Man kan imidlertid få et dynamisk antal arrays ved at lave en class collection, hvor hver klasse i samlingen har et array. Det lyder måske kompliceret, men er pærelet, og man får en velstruktureret kode.

Eksempel med forfattere og bøger

Forestil dig en tabel med bogtitler og forfattere som nedenfor:

Books and authors

Listen kan være meget længere, og i stedet for bøger og forfattere kan det være alt muligt andet - fx varer i forskellige varegrupper.

Vi ønsker det oplistet i to comboboxe på en userform; forfattere i ComboBox1 og titler i ComboBox2. Valget af forfatter skal afgøre, hvilke titler der vises i ComboBox2. Således:

ComboBox

Man kan udfylde listen i en combobox på flere måder (se min side om ListBoxe). I et tilfælde som her er det besværligt at bruge RowSource, og metoden med AddItem er langsom, hvis listen er lang.

Det ideelle i et tilfælde som her er et array som kilde til listen. Så fylder man helt enkelt ComboBox2 (bogtitler) ved at skrive:

ComboBox2.List = myArrayX

Men for at gøre det skal du kende antallet af forfattere, så du kan deklarere det rette antal titel-arrays, og hvad så hvis du tilføjer forfattere og titler til listen? Det er noget rod!

I stedet skal du kunne håndtere et dynamisk antal arrays, og løsningen er at lave en class collection, hvor hver klasse i samlingen har et array. Så tilføjer man bare så mange klasser, som man har brug for.

Nedenfor viser jeg, hvordan det kan gøres, men du kan også downloade et regneark med eksemplet.

Du skal bruge et standard VBA-modul, to klassemoduler og en userform med to comboboxe. Tabellen med kildedata skal i eksemplet stå i celle A2:B2 og ned (som vist ovenfor).

I det almindelige standardmodul har jeg følgende kode:


Option Explicit
Public ArraysCol As clArrays  'Vores class collection

Sub ShowCombos()
'Viser vores userform. Klasser og arrays
'defineres af formularens Initialize procedure.
UserForm1.Show
End Sub

Før vi fortsætter med userformen, skal vi lige se klassesamlingen og klassen med arrayet. Begge er lavet som class modules - altså ikke standardmoduler. Først vores class collection.


Option Explicit
Public Key As String             'Nøgle
Public sKey As String            'Sekundær nøgle
Private mcolArrays As Collection 'Vores collection af klasser

Public Function Add(Key As String, Optional sKey As String) As clArray
'Tilføj en Array-klasse til samlingen.

    On Error GoTo ErrorHandle
        
    'Lav et nyt objekt af typen clArray
    Dim objNewMember As clArray
    Set objNewMember = New clArray

    'Giv klassen en nøgle
    objNewMember.Key = Key

    If Len(sKey) = 0 Then
        mcolArrays.Add objNewMember
    Else
        mcolArrays.Add objNewMember, sKey
    End If

    'Føj klassen til samlingen
    Set Add = objNewMember
    'Klassen er nu kopieret til samlingen,
    'og vi kan destruere det oprindelige objekt
    Set objNewMember = Nothing

Exit Function
ErrorHandle:
MsgBox Err.Description & ", Function Add, clArrays"
End Function

Public Sub Remove(vntIndexKey As Variant)
    'Fjerner en klasse fra samlingen
    mcolArrays.Remove vntIndexKey
End Sub

Private Sub Class_Initialize()
    Set mcolArrays = New Collection
End Sub

Private Sub Class_Terminate()
    Set mcolArrays = Nothing
End Sub
'***********************************************************
'Properties
'***********************************************************
Public Property Get Item(vntIndexKey As Variant) As clArray
  Set Item = mcolArrays(vntIndexKey)
End Property

Public Property Get Count() As Long
   'Returnerer antallet af klasser i samlingen
    Count = mcolArrays.Count
End Property

I combobox-eksemplet bruger jeg ikke alt det, der står ovenfor (fx Get Count), men det kan være nyttigt for dig i andre sammenhænge.

Og nu til array-klassen. Vores class collection kan indeholde X eksemplarer af denne klasse; man kan tilføje og fjerne efter behov.


Option Explicit
Public Key As String    'Nøgle
Public sKey As String   'Sekundær nøgle
Private marArray()      'Arrayet

Private Sub Class_Terminate()
   Erase marArray
End Sub

Sub RangeToArray(ByRef rRange As Range)
   'Bruges ikke i dette eksempel, men kan bruges
   'til at kopiere værdierne i et range til
   'arrayet i ét hug.
   ClassArray = rRange.Value
End Sub

Sub DimensionArray(ByVal lRows As Long, ByVal lCols As Long)
   'Redimensionerer arrayet
   ReDim marArray(1 To lRows, 1 To lCols)
End Sub

Public Property Get ClassArray(Optional _
ByVal i As Long, Optional ByVal y As Long) As Variant
    'Find en eller alle værdier
    If i = 0 Or y = 0 Then
        ClassArray = marArray
    Else
        ClassArray = marArray(i, y)
    End If
End Property

Public Property Let ClassArray(Optional _
ByVal i As Long, Optional ByVal y As Long, ByVal vData As Variant)
    'Skriv værdier til arrayet
    If i = 0 Or y = 0 Then
        marArray = vData
    Else
        marArray(i, y) = vData
    End If
End Property

Der er flere og andre måder at definere sine klasser på, men denne metode er solid, fordi de "indkapslede" data (her arrayet) deklareres som Private i stedet for Public.

Det er ikke væsentligt her, men i andre sammenhænge er det nemmere at indbygge sikkerhed, end hvis revl og krat er deklareret som Public.

Vi har nu et standardmodul, klassesamlingen og array-klassen. Det sidste, vi mangler, er koden til vores userform med de to comboboxe og en OK-knap.


Option Explicit

Private Sub UserForm_Initialize()
'Denne procedure kører, før formularen åbner.
Dim lCount As Long               'Tæller
Dim lRow As Long                 'Tæller
Dim dCount2 As Double            'Tæller
Dim rInput As Range              'Input range
Dim arTable()                    'Array for værdierne i inputtabellen
Dim colAuthors As New Collection 'Collection med forfatternavne
Dim vAuthor As Variant           'Variabel for forfatternavn

'Sæt rInput = tabellen med bøger og forfattere
Set rInput = Range("A2", Range("A2").End(xlDown).Offset(0, 1))

'For bedre hastighed kopieres tabellen til et array
arTable = rInput.Value

'Lav en forfatterliste. Ved at tilføje navnet som sekundær nøgle
'tilføjes hvert forfatternavn kun én gang.
'Når en dublet tilføjes, giver det en fejl, og derfor
'skriver vi nu: On Error Resume Next
On Error Resume Next

For lCount = 1 To UBound(arTable)
   colAuthors.Add arTable(lCount, 2), arTable(lCount, 2)
Next

On Error GoTo ErrorHandle

Set ArraysCol = New clArrays

'Nu tilføjer vi et array med forfatternavne
'til vores class collection, ArraysCol.
'Dette array bruges som kilde til listen i ComboBox1.
'Man kunne også gennemløbe colAuthor
'og tilføje navnene med AddItem-metoden,
'men nu er det arrays, der er på dagsordenen,
'så lad os være konsekvente.
ArraysCol.Add "Authors", "Authors"

With ArraysCol.Item("Authors")
   'Dimensionerer arrayet ved at kalde
   'klassens DimensionArray procedure.
   .DimensionArray colAuthors.Count, 1
   'Tilføj forfatteren til arrayet
   For lCount = 1 To colAuthors.Count
      .ClassArray(lCount, 1) = colAuthors.Item(lCount)
   Next
End With

'Tilføj en klasse med bogtitler for hver forfatter
For Each vAuthor In colAuthors
   'Klassen får forfatternavnet som nøgle.
   'På den måde vil valget i ComboBox1
   'være nøglen til klassen med forfatterens
   'bogtitler, og når der vælges forfatter i
   'ComboBox1, vil ComboBox1_Change proceduren
   'automatisk opdatere listen i ComboBox2 ved at sætte
   'list = arrayet i klassen, der har forfatternavnet
   'som nøgle.
   ArraysCol.Add CStr(vAuthor), CStr(vAuthor)
   'Brug regnearksfunktionen Tæl.Hvis til at
   'returnere antallet af rækker med forfatternavnet.
   'CountIf kræver et Range og virker ikke med arrays.
   dCount2 = _
   Application.WorksheetFunction.CountIf(rInput.Columns(2), vAuthor)
   'Dimensionér bog-arrayet
   With ArraysCol.Item(vAuthor)
      .DimensionArray dCount2, 1
      'Reset tæller
      lRow = 0
      'Gennemløber arrayet arTable og tilføjer titler
      'til forfatterens bog-array.
      For lCount = 1 To UBound(arTable)
         If arTable(lCount, 2) = vAuthor Then
            lRow = lRow + 1
            'Tilføj bogens titel
            .ClassArray(lRow, 1) = arTable(lCount, 1)
         End If
      Next
   End With
Next

'Tilføj forfatterne til listen i ComboBox1. Ændringen
'starter automatisk ComboBox1_Change proceduren og fylder
'ComboBox2 med forfatterens bogtitler.
With ComboBox1
   .List = ArraysCol.Item("Authors").ClassArray
   .Text = .List(0)
   'Match kræves. Brugeren skal ikke kunne indtaste et
   'forfatternavn, som ikke er på listen.
   .MatchRequired = True
End With

BeforeExit:
On Error Resume Next
Set rInput = Nothing
Set colAuthors = Nothing
Set vAuthor = Nothing
Erase arTable

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure UserForm_Initialize"
Resume BeforeExit
End Sub

Private Sub ComboBox1_Change()
   'Listen i ComboBox2 får titlerne
   'fra forfatterens bog-array
   With ComboBox2
      .List = ArraysCol.Item(ComboBox1.Text).ClassArray
      .Text = .List(0)
   End With
End Sub

Private Sub CommandButton1_Click()
MsgBox "Skriv din egen kode baseret på brugerens valg."
Unload Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Sætter klassesamlingen til Nothing
Set ArraysCol = Nothing
End Sub

Nu har du en combobox, som styrer indholdet i en anden combobox, og det kan være nyttigt at vide, hvordan man kan håndtere et dynamisk antal arrays.

I dette eksempel kan du bare tilføje forfattere og bøger til listen, og VBA-koden finder selv ud af resten.

I stedet for comboboxe kan man også bruge listboxe - metoder og egenskaber er langt hen ad vejen de samme.

Relateret: