AW: ComboBox ohne doppelte mit Bedingungen
22.01.2022 02:36:49
ralf_b
hier mein Vorschlag. Ohne Garantie, da ich nicht alles so richtig kapiert habe.
Private Sub c_KD_Change()
Dim L1 As Long
Dim i As Integer
Dim lVal As Long
Dim bx As Boolean
If Me.Tag = "X" Then Exit Sub
c_Rechnung_Art.Clear
If data.Range("bv2") = "" Then
c_Rechnung_Art.AddItem 4001 & "_" & c_KD.List(c_KD.ListIndex, 2) & "_1.AB"
c_Rechnung_Art.AddItem 4001 & "_" & c_KD.List(c_KD.ListIndex, 2) & "_SR"
Else
lVal = WorksheetFunction.Max(data.Columns("bv"))
For L1 = 2 To data.Cells(Rows.Count, "bz").End(xlUp).Row
If Right(data.Cells(L1, "bz"), 2) = "SR" Then
bx = True
ElseIf Right$(data.Cells(L1, "bz"), 2) = "AB" And data.Cells(L1, "ca") = c_KD.List(c_KD.ListIndex, 2) Then
i = i + 1
End If
Next
If bx Then
c_Rechnung_Art.AddItem lVal + 1 & "_" & i + 1 & ".AB"
Else
c_Rechnung_Art.AddItem lVal + 1 & "_1.AB"
End If
c_Rechnung_Art.AddItem lVal + 1 & "_SR"
End If
End Sub
Private Sub c_NA_Change()
Dim L As Long, L1 As Long
Dim MyDic As Object
Dim sT As String, sT1 As String
Dim i As Long, i1 As Long
Dim arrV As Variant, arrL() As Variant
Dim bx As Boolean
Set MyDic = CreateObject("Scripting.Dictionary")
c_KD.Clear
c_KD.ColumnCount = 3
If c_NA.Value = "Neue Rechnung" Then
With data
For L = 2 To .Cells(Rows.Count, "dc").End(xlUp).Row 'kunden suchen ohne doppelte mit Bedingung das "DD"
For L1 = 2 To .Cells(Rows.Count, "bx").End(xlUp).Row
If .Cells(L1, "bx").Value & .Cells(L1, "by").Value & .Cells(L1, "ca").Value = _
.Cells(L, "dc").Value & .Cells(L, "du").Value & .Cells(L, "dd").Value Then
'Kunde muß in "DC" vorhanden sein
If Not Right$(.Cells(L1, "bz"), 2) = "SR" Then
sT = .Cells(L, "dc").Value & .Cells(L, "du").Value & .Cells(L, "dd").Value 'Kunde, KDnr, ABR _ Kunden in Liste anzeigen
MyDic(sT) = Array(.Cells(L, "dc").Value, .Cells(L, "du").Value, .Cells(L, "dd").Value)
End If
End If
Next
Next L
End With
End If
If MyDic.Count Then
arrV = MyDic.items
ReDim arrL(1 To MyDic.Count, 1 To 3)
For i1 = 1 To MyDic.Count
For i = 1 To 3
arrL(i1, i) = arrV(i1 - 1)(i - 1)
Next i
Next
End If
c_KD.List = arrL
End Sub