HERBERS Excel-Forum - das Archiv
Bewerten Sie hier bitte das Excel-Portal
@Sepp Dropdown mit automatischer Sortierung
werner

Hallo und guten Abend
Josef Ehrensberger hat gestern eine tolle Möglichkeit des Dropdowns gezeigt +Hyperlink (toll)
https://www.herber.de/bbs/user/66826.xls die ich nachbauen konnte. Mit meinen nicht ausreichenden Kentnissen habe ich versucht eine 2. Dropdownliste einzufügen.
https://www.herber.de/bbs/user/66828.xls
Das klappte nicht. Wieviele Fehler habe ich denn da gemacht ?
Ich habe extra einen neuen Thread aufgemacht, da der alte für mich erledigt war.
wäre schön wenn ich eine Lösung bekommen würde
Tschüs Werner

AW: @Sepp Dropdown mit automatischer Sortierung
Josef

Hallo Wener,
Wieviele Fehler habe ich denn da gemacht ?
Eigentlich nur einen, du hast das "End If" falsch gesetzt. In dem Fall ist es aber sinnvoller,
mit "If - Then > ElseIf - Then > End If" zu arbeiten.
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim vntList As Variant, strList As String
  Dim vntList2 As Variant, strList2 As String
  If Target.Column = 1 Then 'Spalte mit Artikelbezeichnungen, 1 = A
    vntList = UniqueList(Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row), True)
    strList = Join(vntList, ",")
    With Sheets("Tabelle2").Range("B2:B100") 'Tabelle und Bereich mit dem Gültigkeits-Dropdown
      .Validation.Delete
      .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=strList
    End With
    '##
  ElseIf Target.Column = 3 Then 'Spalte mit Artikelbezeichnungen, 3 = C
    vntList2 = UniqueList2(Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row), True)
    strList2 = Join(vntList2, ",")
    With Sheets("Tabelle2").Range("D2:D30 ") 'Tabelle und Bereich mit dem Gültigkeits-Dropdown
      .Validation.Delete
      .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=strList2
    End With
  End If
End Sub

Gruß Sepp

Außerdem ist es nicht notwendig ....
Josef

... die Variablen doppelt zu deklarieren.
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim vntList As Variant, strList As String
  
  If Target.Column = 1 Then 'Spalte mit Artikelbezeichnungen, 1 = A
    vntList = UniqueList(Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row), True)
    strList = Join(vntList, ",")
    With Sheets("Tabelle2").Range("B2:B100") 'Tabelle und Bereich mit dem Gültigkeits-Dropdown
      .Validation.Delete
      .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=strList
    End With
    '##
  ElseIf Target.Column = 3 Then 'Spalte mit Artikelbezeichnungen, 3 = C
    vntList = UniqueList2(Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row), True)
    strList = Join(vntList, ",")
    With Sheets("Tabelle2").Range("D2:D30 ") 'Tabelle und Bereich mit dem Gültigkeits-Dropdown
      .Validation.Delete
      .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
        Operator:=xlBetween, Formula1:=strList
    End With
  End If
End Sub

Gruß Sepp

AW: @Sepp Dropdown mit automatischer Sortierung
werner

Hallo Sepp
Danke das du dich um mein Problem gekümmert hast.
Ich habe den Code nach deiner Vorlage eingesetzt und folgende Meldung bekommen
https://www.herber.de/bbs/user/66852.jpg
Muss ich die Function umschreiben?
Tschüs Werner
AW: @Sepp Dropdown mit automatischer Sortierung
Josef

Hallo Werner,
die Funktion "UniqueList" und die Prozedur "QuickSort" aus der ersten Datei, musst du natürlich auch
in das Modul kopieren.
Gruß Sepp

AW: @Sepp Dropdown mit automatischer Sortierung
werner

Danke Josef
die Funktion und Prozedur war schon kopiert. Das Bild war ja nur ein Ausschnitt
aber erst nachchem ich diese Funktion eingefügt habe klappte es.
Private Function UniqueList2(Matrix As Range, Optional Sorted As Boolean = True) As Variant
Dim objDic As Object, rng As Range, varTmp() As Variant
Set objDic = CreateObject("Scripting.Dictionary")
For Each rng In Matrix
If rng.Value <> "" Then objDic(rng.Value) = 0
Next
varTmp = objDic.keys
If Sorted Then QuickSort varTmp
UniqueList2 = varTmp
Set objDic = Nothing
End Function
Fertige Datei: https://www.herber.de/bbs/user/66856.xls
Tschüs und Danke Werner
AW: @Sepp Dropdown mit automatischer Sortierung
Josef

Hallo Werner,
das "2" hab ich überlesen, und es ist auch absolut unnötig und unsinnig. Die Funktion "UniqueList"
kannst du immer wieder verwenden, du brauchst sie nicht für jedesmal umbenennen.
Gruß Sepp

AW: @Sepp Dropdown mit automatischer Sortierung
werner

Danke Sepp
jetzt ist alles O.K
hatte mit deiner Beschreibung vollen Erfolg.
Guten Rutsch
Tschüs Werner