Vorschläge für besseren Code
04.09.2017 09:36:17
Peter
ich habe eine UF mit einigen Comboboxen.
Es gibt auf einem Panel, immer 3 zusammen gehörende Comboboxen.
(Insgesamt 3x7, es werden also insgesamt 21 befüllt)
Die erste beinhaltet Spaltenüberschriften.
Die anderen beiden, erhalten Werte, entsprechend der Überschrift, also dem Inhalt der ersten Combobox.
Der Code den ich verwende, funktioniert.
Nur glaube ich, gibt es da was besseres und wollte euch fragen,
wie ihr das ganze machen würdet.
Der unten stehende Sub "AddHeaderToCombobox" wird in einem Klassenweiten Combobox_Changed Event aufgerufen und gilt für insgesamt 7 Comboboxen
Hier Code der die erste befüllt:
Option Explicit
Private probeSheet As Worksheet
Public Sub AddHeaderToCombobox(ByVal frm As MSForms.UserForm)
Dim dict As Dictionary
Dim varKey As Variant
Dim i As Integer
Set probeSheet = ThisWorkbook.Sheets("Probendaten")
Set dict = HeaderData
For i = 1 To 7
For Each varKey In dict.Keys
frm.Controls("cb_Probenform" & i).AddItem varKey
Next varKey
Next i
Set dict = Nothing
Set probeSheet = Nothing
End Sub
Private Function HeaderData() As Dictionary
Dim dict As New Dictionary
Dim tmp As String
Dim lCol As Long
Dim i As Integer
With probeSheet
lCol = LastCol()
For i = 1 To lCol
tmp = .Cells(1, i).value
If Not dict.Exists(tmp) And tmp "" Then dict.Add tmp, 0
Next i
End With
Set HeaderData = dict
Set dict = Nothing
End Function
Private Function LastCol() As Long
With probeSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
End Function
Hier der Code der die anderen beiden befüllt:
Private Function LastRow(ByVal column_ As Long) As Long
With probeSheet
LastRow = .Cells(.Rows.Count, column_).End(xlUp).Row
End With
End Function
Public Sub SpecificDataToForm(ByVal frm As MSForms.UserForm, comboIndex As Integer, varItem As _
Variant)
Dim dict As Dictionary
Dim varListItem As Variant
Dim cb_1 As MSForms.ComboBox
Dim cb_2 As MSForms.ComboBox
Set probeSheet = ThisWorkbook.Sheets("Probendaten")
Set dict = DataDictionary(varItem)
Set cb_1 = frm.Controls("cb_Werkstatt" & comboIndex)
Set cb_2 = frm.Controls("cb_Prüfung" & comboIndex)
For Each varListItem In dict(dict.Keys(0))
cb_1.AddItem varListItem
Next varListItem
For Each varListItem In dict(dict.Keys(1))
cb_2.AddItem varListItem
Next varListItem
cb_1.Text = cb_1.list(0, 0)
cb_2.Text = cb_2.list(0, 0)
Set dict = Nothing
Set probeSheet = Nothing
End Sub
Private Function DataDictionary(ByVal varItem As Variant) As Dictionary
Dim dict As New Dictionary
Dim list_ As New ArrayList
Dim rng As Range, c
Dim lCol As Long
Dim lRow As Long
Dim i As Long
Dim firstAddress
lCol = LastCol
With probeSheet
Set rng = .Range(.Cells(1, 1), .Cells(1, lCol))
Set c = rng.Find(varItem, After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
lRow = LastRow(c.Column)
For i = 2 To lRow
list.Add .Cells(i, c.Column).value
Next i
dict.Add (varItem & c.Column), list
Set list = Nothing
Set c = rng.FindNext(c)
Loop While Not c Is Nothing And c.Address firstAddress
End If
End With
Set DataDictionary = dict
Set dict = Nothing
Set list = Nothing
End Function