VBA:Gültigkeitsdropdown und Autoeingabe
20.09.2015 17:22:53
Reto
Auf meine erste Frage hat sich leider niemand gemeldet, allerdings war in meiner Beispieldatei die Gültigkeit auch noch falsch definiert - ich versuche es nochmals.
Mein Ziel:
- In den Zelle F27 wählt der User eine Kategorie (von 9 Kategorien) aus.
- Abhängig von dieser Kategorie sollen im Drop-Down nur die in der entsprechenden Kategorie-Tabelle (siehe Tabelle "Namen") definierten Ausdrücke auswählbar sein.
- In der Zelle I71 soll der User die Möglichkeit haben einen Wert einzutippen, mit Enter zu bestätigen und Excel springt im Drop-Down an die entsprechende Stelle.
Das ganze soll für die Zellen I27:I71 funktionieren.
Der aktuelle Code leistet folgendes:
- Gültigkeitsdropdown in den Zellen I27:I71 basierend auf einer (1) im Sheet TEST definierten Liste
- Der Gültigkeitsdropdown ist momentan so definiert: Zulassen: Liste Quelle:=Suchbegriffe
- Autovervollständigung beim Erfassen von Text in der entsprechenden Zelle I27:I71 (beim Erfassen von "Tr" und bestätigen mit Enter, springt man im Drop-Down zur ersten Position mit "Tr.....").
Über Antworten, Workarounds und Ideen freue ich mich sehr.
Vielen Dank und Grüsse.
Reto
Aktueller Code und .XLS-File
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column 9 Or Target.Row 71 Then Exit Sub
Application.EnableEvents = False
Suchbegriff = "#" & Range(Target.Address)
Eingabe = Range(Target.Address)
Do
With ActiveWorkbook.Sheets("TEST").Columns("B:B")
Set c = .Find(Suchbegriff, After:=Range("$B$1"), LookAt:=xlPart)
If Not c Is Nothing Then
Exit Do
Else
Suchbegriff = Left(Suchbegriff, Len(Suchbegriff) - 1)
End If
End With
Loop
Sheets("Tab1").Range(Target.Address) = Sheets("TEST").Cells(c.Row, 1)
If Eingabe Sheets("TEST").Cells(c.Row, 1) Then SendKeys "%{DOWN}"
Endhandler:
Sheets("Tab1").Range(Target.Address).Select
Application.EnableEvents = True
End Sub
https://www.herber.de/bbs/user/100094.xls