AW: Dropdown mit Bedingungen
08.02.2018 22:39:15
KlausF
Hallo Grit,
anbei eine Lösung, die bei mir (Excel 2003, Mac) funktioniert
(geht vielleicht auch einfacher).
Es gibt allerdings einen kleinen Haken:
Kommas in den Texten werden von Excel als Trenner für die einzelnen Werte
im Dropdown interpretiert. Es dürfen also keine Kommas in den Texten stehen.
Ich habe die Stellen mal gelb unterlegt ...
https://www.herber.de/bbs/user/119669.xls
Gruß
Klaus
Sub Nummer()
' schreibt aus einer unsortierten Spalte alle vorkommenden
' Begriffe ohne Duplikate in eine neue Liste
Dim strNummer As String
Dim i As Long
Dim lastRow As Long
lastRow = Worksheets("Auswahl").Cells(Rows.Count, "A").End(xlUp).Row
With Worksheets("Auswahl")
For i = 2 To lastRow
If Not IsEmpty(.Cells(i, "A")) Then
' wenn Wert das erste Mal vorkommt,
If Application.WorksheetFunction.CountIf(.Range(.Cells(i, "A"), .Cells(1, "A")), .Cells(i, "A").Value) = 1 Then
strNummer = strNummer & .Cells(i, "A") & ","
End If
End If
Next i
End With
'Letztes Komma entfernen
strNummer = Left(strNummer, Len(strNummer) - 1)
On Error Resume Next
With Worksheets("Eingabe").Range("D6:D" & Rows.Count).Validation
.Delete
.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=strNummer
.IgnoreBlank = True
.InCellDropdown = True
End With
On Error GoTo 0
End Sub
Private Sub Worksheet_Activate()
Call Nummer
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
#If VBA7 Then
If Target.CountLarge > 1 Then Exit Sub
#Else
If Target.Count > 1 Then Exit Sub
#End If
Dim i As Long
Dim strArt As String, strMethode As String
'nur Spalte E ab Zeile 6
If Target.Column = 5 Then
If Target.Row > 5 Then
'wenn Spalte D gleiche Zeile = leer dann Exit
If IsEmpty(Target.Offset(0, -1)) Then
Target = ""
Target.Offset(0, 1) = ""
On Error Resume Next
Target.Validation.Delete
Target.Offset(0, 1).Validation.Delete
On Error GoTo 0
Exit Sub
End If
With Worksheets("Auswahl")
.Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=Target.Offset(0, -1)
For i = 2 To .Range("A1").CurrentRegion.Rows.Count
If .Rows(i).Hidden = False Then
If InStr(strArt, .Cells(i, "B")) = 0 Then
strArt = strArt & .Range("A1").CurrentRegion.Cells(i, "B") & ","
End If
End If
Next i
.AutoFilterMode = False
'Letztes Komma entfernen
strArt = Left(strArt, Len(strArt) - 1)
On Error Resume Next
With Range("E6:E" & Rows.Count).Validation
.Delete
.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=strArt
.IgnoreBlank = True
.InCellDropdown = True
End With
On Error GoTo 0
End With
End If
End If
'nur Spalte F ab Zeile 6
If Target.Column = 6 Then
If Target.Row > 5 Then
'wenn Spalte E gleiche Zeile = leer dann Exit
If IsEmpty(Target.Offset(0, -1)) Then
Target = ""
On Error Resume Next
Target.Validation.Delete
On Error GoTo 0
Exit Sub
End If
With Worksheets("Auswahl")
.Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=Target.Offset(0, -2)
.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=Target.Offset(0, -1)
For i = 2 To .Range("A1").CurrentRegion.Rows.Count
If .Rows(i).Hidden = False Then
If InStr(strMethode, .Cells(i, "C")) = 0 Then
strMethode = strMethode & .Range("A1").CurrentRegion.Cells(i, "C") & ","
End If
End If
Next i
.AutoFilterMode = False
'Letztes Komma entfernen
strMethode = Left(strMethode, Len(strMethode) - 1)
On Error Resume Next
With Range("F6:F" & Rows.Count).Validation
.Delete
.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=strMethode
.IgnoreBlank = True
.InCellDropdown = True
End With
On Error GoTo 0
End With
End If
End If
End Sub