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:
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:
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
Sub ShowCombos()
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
Public sKey As String
Private mcolArrays As Collection
Public Function Add(Key As String, Optional sKey As String) As clArray
On Error GoTo ErrorHandle
Dim objNewMember As clArray
Set objNewMember = New clArray
objNewMember.Key = Key
If Len(sKey) = 0 Then
mcolArrays.Add objNewMember
Else
mcolArrays.Add objNewMember, sKey
End If
Set Add = objNewMember
Set objNewMember = Nothing
Exit Function
ErrorHandle:
MsgBox Err.Description & ", Function Add, clArrays"
End Function
Public Sub Remove(vntIndexKey As Variant)
mcolArrays.Remove vntIndexKey
End Sub
Private Sub Class_Initialize()
Set mcolArrays = New Collection
End Sub
Private Sub Class_Terminate()
Set mcolArrays = Nothing
End Sub
Public Property Get Item(vntIndexKey As Variant) As clArray
Set Item = mcolArrays(vntIndexKey)
End Property
Public Property Get Count() As Long
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
Public sKey As String
Private marArray()
Private Sub Class_Terminate()
Erase marArray
End Sub
Sub RangeToArray(ByRef rRange As Range)
ClassArray = rRange.Value
End Sub
Sub DimensionArray(ByVal lRows As Long, ByVal lCols As Long)
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
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)
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()
Dim lCount As Long
Dim lRow As Long
Dim dCount2 As Double
Dim rInput As Range
Dim arTable()
Dim colAuthors As New Collection
Dim vAuthor As Variant
Set rInput = Range("A2", Range("A2").End(xlDown).Offset(0, 1))
arTable = rInput.Value
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
ArraysCol.Add "Authors", "Authors"
With ArraysCol.Item("Authors")
.DimensionArray colAuthors.Count, 1
For lCount = 1 To colAuthors.Count
.ClassArray(lCount, 1) = colAuthors.Item(lCount)
Next
End With
For Each vAuthor In colAuthors
ArraysCol.Add CStr(vAuthor), CStr(vAuthor)
dCount2 = _
Application.WorksheetFunction.CountIf(rInput.Columns(2), vAuthor)
With ArraysCol.Item(vAuthor)
.DimensionArray dCount2, 1
lRow = 0
For lCount = 1 To UBound(arTable)
If arTable(lCount, 2) = vAuthor Then
lRow = lRow + 1
.ClassArray(lRow, 1) = arTable(lCount, 1)
End If
Next
End With
Next
With ComboBox1
.List = ArraysCol.Item("Authors").ClassArray
.Text = .List(0)
.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()
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)
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:
|