Hallo,
will man Daten per Combobox aus langen Tabellen auswählen ist es
hilfreich wenn in der Combobox nur die Datenzeilen sind, die den
bisher eingegebenen Buchstaben entsprechen.
Also man wählt in einer HilfsComboBox ein „A“ aus, dann sind in der
eigentlichen Combobox nur die Datensätze von Aa bis Az auswählbar.
Anschließend wählt man dann in der HilfsComboBox den zweiten
Buchstaben aus, z.B. „t“, dann sind in der ComboBox nur diejenigen
Datenzeilen vorhanden die mit Ata… bis Atz… beginnen.
Nachfolgende Codes erwarten die eigentliche Tabelle in
Tabellenblatt „Tabelle4“ und die ComboBoxen usw. in Blatt „Tabelle1“.
Blatt1 muss aus Steuerelementtoolbox zwei Kombinationsfelder
(ComboBox1, ComboBox2) und zwei Textfelder (TextBox1, TextBox2)
besitzen, sowie aus Formular zwei Schaltflöächen besitzen.
Schaltfläche1 trägt die Aufschrift: „Neue Auswahl“, Schaltfläche2 die
Aufschrift „Letzte Auswahl rückgängig“, ihnen sind die entsrechenden
Makros „NeueAuswahl“ und „AuswahlRückgängig“ zuzuordnen.
Die Hilfscombobox ComboBox1 hat immer 26 (bzw. 29 mit ÄÖÜ, einstellbar in Modul1) Einträge,
von A-Z, bzw. ATA-ATZ usw., ComboBox hat immer soviele Einträge, die
sich je nach Auswahl in ComboBox1 ergeben.
Will man die Codes in einer leeren Mappe testen, so erstellt man in
Blatt 4 eine Schaltfläche und weist dieser das Makro „NamenslisteErzeugen“ zu und führt es aus.
Tabelle1!A12 ist die LinkedCell von ComboBox2, man kann kann also
dann mit Sverweis die Restdaten für den endgültig ausgewählten
Eintrag in die Zeile 12 rüberholen.
Getestet wurde der Code mit XL97. Es gibt keine Fehlerfallroutinen.
Falls der Code mal abnippelt, das Makro „ff“ laufen lassen.
Verständlicher was TextBox1 und 2 machen wird es wenn man Tabelle1 so
gestaltet daß folgender Satz zu lesen ist:
Gesamtliste hat [hier jetzt TextBox1] Einträge, in der ComboBox2 sind
davon [hier TextBox2] Einträge verfügbar.
ps: sorry, k.A. warum mistiger PC die Leerzeilen im Code entfernt wenn Html-Tags benutzt werden.
Gruß
Reinhard
In **DieseArbeitsmappe**
Private Sub Workbook\_Open()
Dim N, Gefunden As Boolean
Worksheets("Tabelle1").ComboBox2.LinkedCell = "Tabelle1!A12"
For Each N In ThisWorkbook.CustomDocumentProperties
If N.Name = "Auswahl" Then
Gefunden = True
Exit For
End If
Next N
If Gefunden = False Then
ThisWorkbook.CustomDocumentProperties.Add Name:="Auswahl", LinkToContent:=False, \_
Type:=msoPropertyTypeString, Value:=""
End If
Auswahl = ThisWorkbook.CustomDocumentProperties("Auswahl").Value
Call Aktualisieren
End Sub
Private Sub Workbook\_BeforeClose(Cancel As Boolean)
ThisWorkbook.CustomDocumentProperties("Auswahl").Value = Auswahl
End Sub
in **Tabelle1**
Option Explicit
Private Sub ComboBox1\_Change()
If NichtReagieren = True Then Exit Sub
NichtReagieren = True
Auswahl = ComboBox1.Value
ThisWorkbook.CustomDocumentProperties("Auswahl").Value = Auswahl
Call Aktualisieren
NichtReagieren = False
End Sub
Sub ff()
Application.EnableEvents = True
End Sub
in **Modul1**
Option Explicit
Public Anzahl As Long, NichtReagieren As Boolean, Anfang As Long, Ende As Long, Auswahl As String
'Public Const AuswahlABC As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ" ' mit ÄÖÜ
Public Const AuswahlABC As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ' ohne ÄÖÜ
Public Auswahlliste As Variant
Sub Aktualisieren()
Dim N As Byte
ReDim Auswahlliste(Len(AuswahlABC) - 1)
Application.ScreenUpdating = False
NichtReagieren = True
If Auswahl "" Then
Call Suchen 'in Suchen() wird Anfang, Ende ermittelt
Else
Anfang = 1
Anzahl = ZeilenZaehlen
Ende = Anzahl
End If
Anzahl = ZeilenZaehlen
For N = 0 To UBound(Auswahlliste)
Auswahlliste(N) = Auswahl & Mid(AuswahlABC, N + 1, 1)
Next N
With Worksheets("Tabelle1")
.ComboBox1.ColumnCount = 3
.ComboBox1.Value = "Bitte Auswählen von " & Auswahl & Left(AuswahlABC, 1) & "... -- " & Auswahl & Right(AuswahlABC, 1) & "..."
.ComboBox1.ListRows = Len(AuswahlABC)
.TextBox1.Value = Anzahl
.TextBox2.Value = Ende - Anfang + 1
.ComboBox2.Value = "Bitte Auswählen"
.ComboBox2.ListFillRange = "Tabelle4!A" & Anfang & ":A" & Ende
.ComboBox2.ListRows = 25
.ComboBox1.List() = Auswahlliste
End With
Application.ScreenUpdating = True
NichtReagieren = False
End Sub
Sub NeueAuswahl()
Anzahl = ZeilenZaehlen
Auswahl = ""
ThisWorkbook.CustomDocumentProperties("Auswahl").Value = Auswahl
Call Aktualisieren
End Sub
Sub Suchen()
Dim Zeile As Long
With Worksheets("Tabelle4")
Anfang = 0
On Error Resume Next 'falls nix gefunden wird
Anfang = Application.WorksheetFunction.Match(Auswahl & "\*", .Range("A1:A" & Anzahl), 0)
On Error GoTo 0
Ende = Anfang
If Ende = 0 Then
Ende = -1
Exit Sub
End If
While UCase(Left(.Cells(Ende + 1, 1), Len(Auswahl))) = UCase(Auswahl)
Ende = Ende + 1
If (Ende + 1) \> Rows.Count Then Exit Sub
Wend
End With
End Sub
Function ZeilenZaehlen()
If Worksheets("Tabelle4").Cells(Rows.Count, 1) "" Then
ZeilenZaehlen = Rows.Count
Else
ZeilenZaehlen = Worksheets("Tabelle4").Cells(Rows.Count, 1).End(xlUp).Row
End If
End Function
Sub Sortieren()
With Worksheets("Tabelle4")
Anzahl = ZeilenZaehlen
.Range("A1:A" & Anzahl).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, \_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
.Range("A1").Select
End With
End Sub
Sub AuswahlRueckgaengig()
Auswahl = Left(Auswahl, Len(Auswahl) + 1 \* (Len(Auswahl) \> 0))
ThisWorkbook.CustomDocumentProperties("Auswahl").Value = Auswahl
Call Aktualisieren
End Sub
Sub NamenslisteErzeugen()
Dim Laenge As Byte, L As Byte, Zeile As Long, Wort As String
Dim AuswahlLänge As Byte
Anzahl = 65536
AuswahlLänge = Len(AuswahlABC)
Application.ScreenUpdating = False
' "For Zeile..."-Schleife bedeutend langsamer wenn ohne nachfolgende Begrenzung von ListFillRange
Worksheets("Tabelle1").ComboBox2.ListFillRange = "Tabelle4!A1:A2"
With Worksheets("Tabelle4")
.Columns(1).ClearContents
For Zeile = 1 To Anzahl
Wort = ""
Laenge = Int(Rnd() \* 10) + 5
For L = 1 To Laenge
Wort = Wort & Mid(AuswahlABC, Int(Rnd() \* AuswahlLänge) + 1, 1)
Next L
.Cells(Zeile, 1) = Wort
Next Zeile
.Range("A1:A" & Anzahl).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, \_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
.Range("A1").Select
End With
Anfang = 1
Ende = Anzahl
Worksheets("Tabelle1").ComboBox2.LinkedCell = "Tabelle1!A12"
Auswahl = ""
Call AuswahlSpezifizieren
Application.ScreenUpdating = True
End Sub