Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

@Sepp Dropdown mit automatischer Sortierung

@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
27.12.2009 23:09:02
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

Anzeige
Außerdem ist es nicht notwendig ....
27.12.2009 23:10:56
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

Anzeige
AW: @Sepp Dropdown mit automatischer Sortierung
28.12.2009 19:31:48
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
28.12.2009 20:07:10
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
28.12.2009 21:04:26
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
Anzeige
AW: @Sepp Dropdown mit automatischer Sortierung
29.12.2009 01:27:19
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
29.12.2009 20:23:05
werner
Danke Sepp
jetzt ist alles O.K
hatte mit deiner Beschreibung vollen Erfolg.
Guten Rutsch
Tschüs Werner

303 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige