|
Hallo liebe Forengemeinde,
sorry wegen des Doppeltpostings, kam leider zu schnell auf "Senden":
Ausgangslage:
Ich habe eine Exceltabelle:
A C D
a b
G1 Marke X -MARX
G1 Marke Y -MARY
G1 Marke Z -MARZ
G2 Marke X -MARX
G2 Marke N -MARN
Zur Erläuterung: Die Werte in Spalte D (und später auch in weiteren KomboBoxen) sind abhängig von der Auswahl aus den Werten der Spalte A. Daher habe ich eine VBA UserForm mit zwei KomboBoxen aufgesetzt. Wählt der User nun in KomboBox G1 auf der VBA UserForm aus, kann er in KomboBox2 aus Marke X,Y oder Z wählen, wählt er G2 aus, nur zwischen Marke X und Marke N. Die Einträge in der ersten Zeile dienen als Sprungmarken im Array. Sie sind für die Algorithmik, aber nicht für die Ausgabe relevant.
Das klappt.
In einer TextBox auf der UserForm soll nun ausgegeben werden "G1-MARX". Das klappt nicht.
Ich erhalte den Fehler: Eigenschaft list konnte abgerufen werden, ungültiges Argument.
Ich benutze folgenden Code:
Option Explicit
Dim lngInfoZeile As Long
Dim rngBereich As Range
Private Sub UserForm_Initialize()
Dim i As Integer
With Worksheets("Tabelle1")
Set rngBereich = .Range("A2:D" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub ComboBox1_Enter()
ComboBox1.List = SVERWEISSPECIAL(rngBereich, 1)
End Sub
Private Sub ComboBox1_Change()
TextBox1.Text = TB_fuellen
End Sub
Private Sub ComboBox2_Enter()
On Error Resume Next
ComboBox2.List = SVERWEISSPECIAL(rngBereich, 2, Array(1), Array(ComboBox1))
On Error GoTo 0
End Sub
Private Sub ComboBox2_Change()
TextBox1.Text = TB_fuellen
End Sub
Private Function TB_fuellen() As String
Dim ctrCTR As Control
Dim ctrCB As ComboBox
Dim strTBText As String
Dim ctrSpalte As Long
TB_fuellen = ""
'Spaltennummer mit dem gewünschten Eintrag. Bei einspaltiger ComboBox ist die Spaltennummer=0
ctrSpalte = 1
For Each ctrCTR In Me.Controls
If InStr(1, UCase(ctrCTR.Name), "COMBOBOX", vbBinaryCompare) <> 0 Then
Set ctrCB = ctrCTR
If ctrCB.ListIndex = -1 Then
Set ctrCB = Nothing
Exit Function
Else
Set ctrCB = Nothing
End If
End If
Next
For Each ctrCTR In Me.Controls
If InStr(1, UCase(ctrCTR.Name), "COMBOBOX", vbBinaryCompare) <> 0 Then
Set ctrCB = ctrCTR
strTBText = strTBText & ctrCB.List(ctrCB.ListIndex, ctrSpalte)
Set ctrCB = Nothing
End If
Next
TB_fuellen = strTBText
End Function
Private Function SVERWEISSPECIAL(Matrix As Range, AusgabeSpalte As Integer, Optional KriteriumSpalten As Variant = 0, Optional KriteriumWerte As Variant = 0) As Variant
Dim arr As Variant
Dim DicOut As Object
Dim strVgl1 As String
Dim strVgl2 As String
Dim i As Long
Dim k As Long
On Error GoTo Ende
Set DicOut = CreateObject("Scripting.Dictionary")
arr = Matrix.Value
If Not IsArray(KriteriumSpalten) Or Not IsArray(KriteriumWerte) Then
For i = 1 To UBound(arr)
If arr(i, AusgabeSpalte) <> "" Then _
DicOut(arr(i, AusgabeSpalte)) = ""
Next
Else
For k = 0 To UBound(KriteriumWerte)
strVgl1 = strVgl1 & "'#$#" & KriteriumWerte(k)
Next
For i = 1 To UBound(arr)
strVgl2 = ""
For k = 0 To UBound(KriteriumSpalten)
strVgl2 = strVgl2 & "'#$#" & arr(i, KriteriumSpalten(k))
Next
If arr(i, AusgabeSpalte) <> "" Then _
If strVgl1 = strVgl2 Then _
DicOut(arr(i, AusgabeSpalte)) = ""
Next
End If
If DicOut.Count > 0 Then
arr = DicOut.Keys
QSort arr, LBound(arr), UBound(arr)
SVERWEISSPECIAL = arr
End If
Exit Function
Ende:
SVERWEISSPECIAL = ""
End Function
Sub QSort(ByRef arr, low, hi)
Dim i, j, p
While low < hi
p = arr(hi)
i = low - 1
For j = low To hi - 1
If arr(j) <= p Then
i = i + 1
Swap arr, i, j
End If
Next
Swap arr, i + 1, j
QSort arr, low, i
low = i + 2
Wend
End Sub
Sub Swap(ByRef arr, first, second)
Dim t
t = arr(first)
arr(first) = arr(second)
arr(second) = t
End Sub
Dabei soll die Methode TB_fuellen() den Code einfacher und übersichtlicher gestalten und ist verantwortlich für die Befüllung der Textfelder. Die Methode SVERWEISSPEZIAL ist zuständig für die Realiserung des Abhängigkeitsverhältnis.
Kann mir jemand helfen, warum der besagte Fehler beim Ausführen meines Codes auftritt?
|