AW: Aus drei ComboBoxen ausgew. Daten in Tab. ändern
04.01.2013 10:20:40
Rudi
Hallo,
das ist ziemlich unausgegoren.
Wie stellst du sicher, dass es nur einen Eintrag zur Kombination A&B&C gibt?
Wenn es so ist:
Dim lngRow As Long
Private Sub CommandButton2_Click() 'aktuelle Daten der TextBoxen übernehmen
If lngRow > 0 Then
With Worksheets("Tabelle1").Rows(lngRow + 1)
.Cells(4) = TextBox1
.Cells(5) = TextBox2
.Cells(6) = TextBox3
.Cells(7) = TextBox4
End With
End If
End Sub
Private Sub ComboBox1_Enter()
ComboBox1.List = SVERWEISSPECIAL(rngBereich, 1)
ComboBox2.Clear
ComboBox3.Clear
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
lngRow = -1
End Sub
Private Sub ComboBox2_Enter()
On Error Resume Next
ComboBox2.List = SVERWEISSPECIAL(rngBereich, 2, Array(1), Array(ComboBox1))
On Error GoTo 0
TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
lngRow = -1
End Sub
Private Sub ComboBox3_Enter()
On Error Resume Next
ComboBox3.List = SVERWEISSPECIAL(rngBereich, 3, Array(2), Array(ComboBox2))
On Error GoTo 0
lngRow = -1
End Sub
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)) = ""
lngRow = i
End If
End If
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
Gruß
Rudi