abhängige Listeneinträge in ComboBoxen
27.10.2003 07:41:35
Ilona
Vielleicht kann mir jemand helfen.
Ich habe zwei Kombinationsfelder die einmal mit einer Liste von Kundengruppennummern und die andere mit Kundennamen gefüllt werden. Nun soll aber je nach Auswahl in der einen, der Inhalt in der anderen wechseln. Also bei Kundengruppe 1 sollen nur noch alle Kundennamen angezeigt werden, die zu Kundengruppe 1 gehören und anders herum genauso.
Hier ist mal mein Quelltext:
'den Kombifeldern die Listen zuordnen
Function Kombi(ZellBereich, KombiName) As Boolean
ActiveSheet.Shapes(KombiName).Select
With Selection
.ListFillRange = ZellBereich ' Listenbereich setzen
.LinkedCell = ""
.DropDownLines = 8 ' Anzahl der anzuzeigenden Einträge
.Display3DShading = False
.ListIndex = 1
End With
Kombi = True
End Function
' Erstellen einer Liste aller vorkommenden Kundengruppen
' Zuordnen dieser Listen zum Kombinationsfeld
Sub KDGruppe()
Dim KDGruppe As String, lKDGruppe As String
Dim LineIndex As Integer, OutIndex As Integer
Dim ZellBereich As String
KDGruppe = "@@@@@"
lKDGruppe = "@@@@@"
LineIndex = 8
OutIndex = 2
'Sortieren nach KdGruppe
SortiereKDGruppe
'Ausgabe für alle KdGruppen als ersten Listeneintrag
Worksheets("Import").Cells(1, 34).Value = "alle"
'Ausgabe jeder KdGruppe
Do While (Worksheets("Import").Cells(LineIndex, 1) > "")
KDGruppe = Worksheets("Import").Cells(LineIndex, 11)
If (KDGruppe <> lKDGruppe) And (lKDGruppe <> "@@@@@") Then
Worksheets("Import").Cells(OutIndex, 34).Value = lKDGruppe
OutIndex = OutIndex + 1
End If
lKDGruppe = KDGruppe
LineIndex = LineIndex + 1
Loop
If (lKDGruppe <> "@@@@@") Then
Worksheets("Import").Cells(OutIndex, 34).Value = lKDGruppe
End If
' Bereich ermitteln, wo KdGruppe ausgegeben wird
ZellBereich = "=$AH$1:$AH$" + CStr(OutIndex)
' Name des Kombinationsfeldes
KombiName = "Dropdown 1"
bOK = Kombi(ZellBereich, KombiName)
Worksheets("Import").Range("A1:A1").Select
Exit Sub
End Sub
' Erstellen einer Liste aller vorkommenden Kunden
' Kundennummer zum Unterscheiden, falls gleiche Namen
' Zuordnen dieser Listen zum Kombinationsfeld
Sub Kunde()
Dim Kunde As String, lKunde As String
Dim KNr As Integer, lKNr As Integer
Dim LineIndex As Integer, OutIndex As Integer
Dim ZellBereich As String
Kunde = "@@@@@"
lKunde = "@@@@@"
LineIndex = 8
OutIndex = 2
'Sortieren nach Kunde
SortiereKD
Worksheets("Import").Cells(1, 35).Value = "alle"
Worksheets("Import").Cells(1, 36).Value = -1
Do While (Worksheets("Import").Cells(LineIndex, 1) > "")
Kunde = Worksheets("Import").Cells(LineIndex, 9)
KNr = Worksheets("Import").Cells(LineIndex, 10)
If (Kunde <> lKunde) And (lKunde <> "@@@@@") Then
Worksheets("Import").Cells(OutIndex, 35) = lKunde
Worksheets("Import").Cells(OutIndex, 36) = lKNr
OutIndex = OutIndex + 1
End If
lKunde = Kunde
lKNr = KNr
LineIndex = LineIndex + 1
Loop
If (lKunde <> "@@@@@") Then
Worksheets("Import").Cells(OutIndex, 35) = lKunde
Worksheets("Import").Cells(OutIndex, 36) = lKNr
End If
' Bereich ermitteln, wo KdGruppe ausgegeben wird
ZellBereich = "=$AI$1:$AI$" + CStr(OutIndex)
' Name des Kombinationsfeldes
KombiName = "Dropdown 3"
bOK = Kombi(ZellBereich, KombiName)
Worksheets("Import").Range("A1:A1").Select
Exit Sub
End Sub
Function GetIndex(KombiName) As Integer
Dim nIndex As Integer
Worksheets("Import").Activate
ActiveSheet.Shapes(KombiName).Select
With Selection
nIndex = .ListIndex
End With
GetIndex = nIndex
End Function
Function GetKDGruppe() As String
Dim nIndex As Integer
Dim sKDGruppe As String
nIndex = GetIndex("Dropdown 1")
sKDGruppe = Worksheets("Import").Cells(nIndex, 34)
GetKDGruppe = sKDGruppe
End Function
Function GetKunde() As Integer
Dim nIndex As Integer
Dim KNumber As Integer
nIndex = GetIndex("Dropdown 3")
KNumber = Worksheets("Import").Cells(nIndex, 36)
GetKunde = KNumber
End Function
Function GetKundeName() As String
Dim nIndex As Integer
Dim KName As String
nIndex = GetIndex("Dropdown 3")
KName = Worksheets("Import").Cells(nIndex, 35)
GetKundeName = KName
End Function
Ich hoffe das reicht:
Würde mich über Hilfe freuen. Danke schon mal im Voraus.
ILONA