Hallo zusammen,
Ich habe aktuell 30 Comboboxen, wobei die Daten für die Comoboxen aus einem Tabellenblatt kommen und die jeweis ersten beiden in Abhängkeit die 3. befüllen.
Box 1 = A -> auswahl händisch
Box 2 = B- > auswahl händisch
Box 3 = 120 automatisch
Nun habe ich aber ein Performenceproblem.
Hier meine Frage ist es möglich, das ich nur mit 3 statt 30 Comboxen arbeiten und nach jeder Eingabe per Button einen neuen Datensatz in die nächste leere Zelle schreiben lassen kann? Dies aber maximal 10 mal
' Ereignisroutine, wenn sich ComboBox1 verändert -> ComboBox2 und 3 neu füllen
Private Sub ComboBox1_Change()
ComboBox3.Clear
ComboBox2.Clear
If ComboBox1.ListIndex = -1 Then Exit Sub
Call MWFillComboBoxFromTableColumn(Tabelle1, 2, ComboBox2, 1, ComboBox1.Text)
If ComboBox2.ListCount >= 1 Then ComboBox2.ListIndex = 0
Range("D4") = ComboBox1.Value
End Sub
'Ereignisroutine, wenn sich ComboBox4 verändert -> ComboBox5 und 6 neu füllen
Private Sub ComboBox4_Change()
ComboBox6.Clear
ComboBox5.Clear
If ComboBox4.ListIndex = -1 Then Exit Sub
Call MWFillComboBoxFromTableColumn(Tabelle1, 2, ComboBox5, 1, ComboBox4.Text)
If ComboBox5.ListCount >= 1 Then ComboBox5.ListIndex = 0
Range("D5") = ComboBox4.Value
End Sub
usw.
'Ereignisroutine, wenn sich ComboBox2 verändert -> ComboBox3 neu füllen
Private Sub ComboBox2_Change()
ComboBox3.Clear
If ComboBox2.ListIndex = -1 Then Exit Sub
Call MWFillComboBoxFromTableColumn(Tabelle1, 3, ComboBox3, 1, ComboBox1.Text, 2, ComboBox2.Text)
If ComboBox3.ListCount >= 1 Then ComboBox3.ListIndex = 0
Range("E4") = ComboBox2.Value
End Sub
'Ereignisroutine, wenn sich ComboBox5 verändert -> ComboBox6 neu füllen
Private Sub ComboBox5_Change()
ComboBox6.Clear
If ComboBox5.ListIndex = -1 Then Exit Sub
Call MWFillComboBoxFromTableColumn(Tabelle1, 3, ComboBox6, 1, ComboBox4.Text, 2, ComboBox5.Text)
If ComboBox6.ListCount >= 1 Then ComboBox6.ListIndex = 0
Range("E5") = ComboBox5.Value
End Sub
usw.
Private Sub ComboBox3_Change()
Range("F4") = ComboBox3.Value
End Sub
Private Sub ComboBox6_Change()
Range("F5") = ComboBox6.Value
End Sub
usw.
Private Sub MWFillComboBoxFromTableColumn(ByRef oSheet As Object, _
ByVal lColumn As Long, ByRef oComboBox As Object, _
Optional ByVal lColBedingung1 As Long = 0, Optional ByVal sBedingung1 As String = "", _
Optional ByVal lColBedingung2 As Long = 0, Optional ByVal sBedingung2 As String = "")
Dim z As Long
Dim zMax As Long
Dim bFlag As Boolean
oComboBox.Clear
zMax = oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count - 1
For z = lSTARTZEILE To zMax
If Trim(CStr(oSheet.Cells(z, lColumn).Value)) <> "" Then
bFlag = True
If lColBedingung1 <> 0 Then
If LCase(Trim(CStr(oSheet.Cells(z, lColBedingung1)))) <> LCase(Trim(sBedingung1)) Then
bFlag = False
End If
End If
If lColBedingung2 <> 0 Then
If LCase(Trim(CStr(oSheet.Cells(z, lColBedingung2)))) <> LCase(Trim(sBedingung2)) Then
bFlag = False
End If
End If
If bFlag = True Then
Call MWFillNonDuplicatesToComboBox(oComboBox, oSheet.Cells(z, lColumn).Value)
End If
End If
Next z
End Sub
Private Sub MWFillNonDuplicatesToComboBox(ByRef oComboBox As Object, ByVal sAddText As String)
Dim i As Long
Dim bFlag As Boolean
If oComboBox.ListCount = 0 Then
oComboBox.AddItem sAddText
Else
bFlag = False
For i = 0 To oComboBox.ListCount - 1
If LCase(Trim(CStr(oComboBox.List(i)))) = LCase(Trim(CStr(sAddText))) Then
bFlag = True
Exit For
End If
Next i
If bFlag = False Then
oComboBox.AddItem sAddText
End If
End If
End Sub
Vieleicht hat jemand eine Lösung für mich...ich bin leider noch noch ein blutiger Anfänger...danke euch!