Microsoft Excel

Herbers Excel/VBA-Archiv

@Sepp Dropdown mit automatischer Sortierung | Herbers Excel-Forum


Betrifft: @Sepp Dropdown mit automatischer Sortierung von: werner
Geschrieben am: 27.12.2009 20:37:16

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

  

Betrifft: AW: @Sepp Dropdown mit automatischer Sortierung von: Josef Ehrensberger
Geschrieben am: 27.12.2009 23:09:02

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



  

Betrifft: Außerdem ist es nicht notwendig .... von: Josef Ehrensberger
Geschrieben am: 27.12.2009 23:10:56

... 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



  

Betrifft: AW: @Sepp Dropdown mit automatischer Sortierung von: werner
Geschrieben am: 28.12.2009 19:31:48

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


  

Betrifft: AW: @Sepp Dropdown mit automatischer Sortierung von: Josef Ehrensberger
Geschrieben am: 28.12.2009 20:07:10

Hallo Werner,

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


Gruß Sepp



  

Betrifft: AW: @Sepp Dropdown mit automatischer Sortierung von: werner
Geschrieben am: 28.12.2009 21:04:26

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


  

Betrifft: AW: @Sepp Dropdown mit automatischer Sortierung von: Josef Ehrensberger
Geschrieben am: 29.12.2009 01:27:19

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



  

Betrifft: AW: @Sepp Dropdown mit automatischer Sortierung von: werner
Geschrieben am: 29.12.2009 20:23:05

Danke Sepp
jetzt ist alles O.K
hatte mit deiner Beschreibung vollen Erfolg.

Guten Rutsch

Tschüs Werner


Beiträge aus den Excel-Beispielen zum Thema "@Sepp Dropdown mit automatischer Sortierung"