Office: DropDown in UF soll drei Bereiche untereinander anzeigen

Ein frohes und gesundes neues Jahr wünsche ich Euch.


Ich hatte hier:
http://www.office-hilfe.com/support/topic,13518,-4-fragen-zu-dropdown-in-userform.html
schon verschiedenes gefragt und eigentlich auch schon die Lösung für das aktuelle Problem bekommen, so dachte ich.
Leider ist da doch noch ein Fehler drin.


In UserForm1 soll die ComboBoxLieferantEmpfänger in Abhängigkeit der Eingabe in ComboBoxVorgangAbkürzung gefüllt werden.
Es stehen drei definierte Bereiche zur Auswahl.
Soweit klappt das auch super.

Aber, wenn in ComboBoxVorgangAbkürzung der eingegebene Wert nicht bestimmten Vorgaben entspricht, dann sollen alle drei definierten Bereiche in der ComboBoxLieferantEmpfänger untereinander aufgelistet werden.
Und genau da klemmt es noch.
Ich hab jetzt schon einiges Probiert, bekomme es aber leider nicht hin.


Es werden zwar im "Case else" die drei Bereiche aufgelistet, und wenn ich mit der Maus im DD scrolle klappt auch alles, aber die Komplette UF soll nur über die Tastatur ausgefüllt werden (Schnelligkeit bei der Arbeit halt).
Und wenn ich mit der TAB-Taste in der ComboBoxLieferantEmpfänger lande und dann mit der Pfeiltaste nach unten scrolle, springt die Eingabe und Anzeige immer wieder auf den ersten Wert, sobald ich unterhalb des ersten der drei Bereiche angekommen bin.

Code:

Private Sub ComboBoxLieferantEmpfänger_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'je nach Auswahl in Vorgang nur bestimmte Auflistung in Lieferant_Empfänger
  Dim RgL As Range, RgE As Range, RgS As Range, Rg As Range
  With Sheets("Stammdaten")
    Select Case ComboBoxVorgangAbkürzung
    Case "WE", "Ret. WA", "Pal. Abh. Lief."
      Set Rg = .Range("Lieferant"): Set Rg = Rg.Resize(Rg.End(xlDown).Row)
    Case "WA", "Ret. WE", "Pal. Anl. Empf."
      Set Rg = .Range("Empfänger"): Set Rg = Rg.Resize(Rg.End(xlDown).Row)
    Case "Pal. Anl. Sped.", "Pal. Abh. Sped."
      Set Rg = .Range("Spedition"): Set Rg = Rg.Resize(Rg.End(xlDown).Row)
    Case Else
      'alle drei Bereiche auflisten
      Set Rg = .Range("Lieferant"): Set Rg = Rg.Resize(Rg.End(xlDown).Row)
      Set RgE = .Range("Empfänger"): Set RgE = RgE.Resize(RgE.End(xlDown).Row)
      Set RgS = .Range("Spedition"): Set RgS = RgS.Resize(RgS.End(xlDown).Row)
      Set RgL = Application.Union(RgE, RgS)
    End Select
  End With
  With ComboBoxLieferantEmpfänger
    .List = Rg.Value
    If Not RgL Is Nothing Then
      For Each Rg In RgL.Cells
        .AddItem Rg.Value
      Next Rg
    End If
  End With
  Me.ComboBoxLieferantEmpfänger.DropDown
End Sub

Ich vermute, das dieser Fehler etwas mit

Code:

  With ComboBoxLieferantEmpfänger
    .List = Rg.Value

zu tuen hat, und das im Case else die erste Range RGL, und die Unit Rg sein müßte. Dann weiß ich aber nicht wie ich den unteren If Not Teil abändern muss.


Wie gesagt, probiert hab ich schon verschiedenes, leider bisher ohne Erfolg.
Ich hoffe ich habe mich verständlich ausgedrückt.

liebe Grüße Achim

 

Hallo Achim,

das Problem mit der Listenauswahl ist nicht aufgetreten, wenn man die Listeneinträge mit der Maus ausgewählt hat, jedoch wenn man dies mit der Tastatur versucht hat.

Grund: Bei jedem Loslassen einer Taste (auch der Cursor-Down-Taste) nach deren Drücken wird das KeyUp-Ereignis ausgelöst und somit die Sub ComboBoxLieferantenEmpfänger_KeyUp(..) ausgeführt und das auch dann, wenn die Liste schon längst erstellt ist und man nur in der Liste scrollen will - was bei Auswahl mittels Maus nicht stattfindet.

Lösung:
Ich habe daher beide Funktionalitäten voneinander getrennt, indem ich die Listenerstellung für die Combobox dem Enter-Ereignis anvertraut habe, während ich das Listenaufklappen beim KeyUp-Ereignis belassen habe. Sonst habe ich, was diese Combobox betrifft, nichts verändert.

Code:

Private Sub ComboBoxLieferantEmpfänger_Enter()
  Dim RgL As Range, RgE As Range, RgS As Range, Rg As Range
'je nach Auswahl in Vorgang nur bestimmte Auflistung in Lieferant_Empfänger
  With Sheets("Stammdaten")
    Select Case ComboBoxVorgangAbkürzung
    Case "WE", "Ret. WA", "Pal. Abh. Lief."
      Set Rg = .Range("Lieferant"): Set Rg = Rg.Resize(Rg.End(xlDown).Row)
    Case "WA", "Ret. WE", "Pal. Anl. Empf."
      Set Rg = .Range("Empfänger"): Set Rg = Rg.Resize(Rg.End(xlDown).Row)
    Case "Pal. Anl. Sped.", "Pal. Abh. Sped."
      Set Rg = .Range("Spedition"): Set Rg = Rg.Resize(Rg.End(xlDown).Row)
    Case Else
      'alle drei Bereiche auflisten
      Set Rg = .Range("Lieferant"): Set Rg = Rg.Resize(Rg.End(xlDown).Row)
      Set RgE = .Range("Empfänger"): Set RgE = RgE.Resize(RgE.End(xlDown).Row)
      Set RgS = .Range("Spedition"): Set RgS = RgS.Resize(RgS.End(xlDown).Row)
      Set RgL = Application.Union(RgE, RgS)
    End Select
  End With
  With Me.ComboBoxLieferantEmpfänger
    .List = Rg.Value
    If Not RgL Is Nothing Then
      For Each Rg In RgL.Cells
        .AddItem Rg.Value
      Next Rg
    End If
  End With
End Sub
Private Sub ComboBoxLieferantEmpfänger_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  Me.ComboBoxLieferantEmpfänger.DropDown
End Sub

Hier nochmals die Excel-Datei mit der adaptierten Fassung:

 

@ Exl121150


1. Danke.

Manchmal ist die Lösung so naheliegend und logisch...
Man muss nur drauf kommen.

Ich seh schon, ich habe noch ne Menge zu lernen bis das Dingen fertig ist.


2. Du bist der Hammer!
Du verbesserst Sachen, zeigst Tricks, nach denen garnicht gefragt war.
Wenn Du ne Datei in der Hand hattest muss man wohl immer mit der Lupe schauen welche kleinen Geschenke Du noch so alles mit eingebaut hast.

Das mit den Public Sub vereinfacht natürlich eine Menge.
Werde mir das nochmal ganz genau in die Rübe hämmern und versuchen auszubauen/öfter zu benutzen.

Dadurch wird der Code übersichtlicher - klar.
Der Code wird um so einige Zeilen reduziert - klar.
Spätere Änderungen/Verbesserungen dürften einfacher machbar sein - klar.

Aber, ansonsten... ist das einfach "nur" ein besserer Stil, oder tut sich da auch was an der Performance und Stabilität? Vor allem wenn die Geschichte mal umfangreicher wird?


liebe Grüße Achim