| Wildcards, AutoFilter | |
| |
| |
| Sub Abfrage1() | Ein Modul startet das Formular (VBA für Excel kennt |
| Abfrage.Show | keinen FormLoad-Befehl). |
| Range("A1").Select | Die Zelle A1 des aktiven Arbeitsblattes wird selektiert. |
| End Sub | |
| |
| Private Sub UserForm_Initialize() | Formular "Abfrage" wird initialisiert. |
| Box2.Text = ActiveSheet.Range("H3").Value | Die TextBoxen erhalten den gespeicherten Inhalt zweier |
| Box1.Text = ActiveSheet.Range("H2").Value | Worksheet-Zellen. |
| Call boxx1 | |
| End Sub | |
| |
| Private Sub boxx1() | Unterprogramm für einige Steuerelemente. |
| With Box1 | |
| .SelStart = 0 | |
| .SelLength = Len(.Text) | Die TextBox1 erhält den Fokus. |
| End With | |
| End Sub | |
| |
| Private Sub aktivieren() | Etwas umständliche Rückgabe des Fokus an die |
| Range("A1").Select | "ersten Zellen" des ArbeitsBlattes. |
| Range("A2").Select | |
| End Sub | |
| Wenn die erste Textbox den Fokus verliert: |
| Private Sub Box1_Exit(ByVal Cancel As MSForms.ReturnBoolean) |
| Dim ZLinks$, ZRechts$ | |
| On Error Resume Next | |
| With Box1 | |
| If .Text <> "" Then | Wenn Textbox nicht leer ist, dann: |
| ActiveSheet.Range("H2").Value = .Text | - erhält eine Worksheet-Zelle den Inhalt der Textbox. |
| ZLinks = Left$(.Text, 1) | - das linke Zeichen des Suchwortes wird geprüft. |
| ZRechts = Right$(.Text, 1) | - das rechte Zeichen des Suchwortes wird geprüft. |
| If ZLinks = "*" And ZRechts = "*" Then | Wenn bereits Wildcards vorhanden sind, dann: |
| .Text = ActiveSheet.Range("H2").Value | - schreibe den Inhalt der Worksheet-Zelle zurück in |
| Else | die Textbox, - andernfalls: |
| .Text = "*" & ActiveSheet.Range("H2").Value & "*" | - füge dem Suchbegriff zwei Wildcards hinzu. |
| End If | |
| End If | |
| .SelStart = 0 | Beim Verlassen der ersten Textbox wird dieser der |
| End With | Fokus genommen. |
| End Sub | |
| |
| Private Sub Box2_Exit(ByVal Cancel As MSForms.ReturnBoolean) |
| Dim ZLinks$, ZRechts$, a$, b$, f% | |
| On Error Resume Next | |
| If Box1.Value = "" Then | Wenn Textbox 1 nicht leer ist, dann: |
| Box1.SetFocus | - Rückkehr zu Textbox 1. |
| Else | |
| With Box2 | |
| If .Text <> "" Then | Wenn Textbox 2 nicht leer ist, dann: |
| ActiveSheet.Range("H3").Value = .Text | - erhält eine Worksheet-Zelle den Inhalt der Textbox. |
| ZLinks = Left$(.Text, 1) | - das linke Zeichen des Suchwortes wird geprüft. |
| ZRechts = Right$(.Text, 1) | - das rechte Zeichen des Suchwortes wird geprüft. |
| If ZLinks = "*" And ZRechts = "*" Then | Wenn bereits Wildcards vorhanden sind, dann: |
| .Text = ActiveSheet.Range("H3").Value | - schreibe den Inhalt der Worksheet-Zelle zurück in |
| Else | die Textbox, - andernfalls: |
| .Text = "*" & ActiveSheet.Range("H3").Value & "*" | - füge dem Suchbegriff zwei Wildcards hinzu. |
| End If | |
| Else | |
| ActiveSheet.Range("H3").Value = "" | |
| End If | |
| Selection.Autofilter | AutoFilter wird aktiviert. |
| a = Box1.Text | |
| b = .Text | |
| If optDeutsch.Value = True Then f = 1 | |
| If optEnglish.Value = True Then f = 2 | |
| If optRoman.Value = True Then f = 3 | |
| If optKapitel.Value = False Then | Fehler abfangen. |
| If Len(a) And Len(b) <> 0 Then Selection.Autofilter Field:=f, _ |
| Criteria1:=a, Operator:=xlOr, Criteria2:=b | |
| If Len(b) = 0 Then Selection.Autofilter Field:=f, Criteria1:=a |
| If Len(a) = 0 Then Box1.SetFocus: Exit Sub | |
| Call aktivieren | |
| End | |
| Else | |
| Exit Sub | Nach Verlassen der zweiten Textbox wird das Programm |
| End If | ausgeführt (Suchen mit Autofilter in gewünschter Spalte). |
| End With | Ein CommandButton ist daher nicht mehr notwendig. |
| End If | |
| End Sub | |
| |
| Private Sub optKapitel_Click() | Hier werden die KapitelKöpfe gesucht. |
| Dim a$, f% | |
| Box2.Text = "" | |
| Box1.Text = "*" | |
| Selection.Autofilter | |
| f = 6 | |
| a = Box1.Text | |
| Selection.Autofilter Field:=f, Criteria1:=a | |
| Call aktivieren | |
| End Sub | |
| |
| Private Sub cmdEnde_Click() | Beenden des Programms. |
| Selection.Autofilter | |
| Unload Me | |
| Call aktivieren | |
| End Sub | |
| |
| Private Sub cmdRoLeer_Click() | In Spalte RO leere Zellen suchen. |
| Dim f%, a$, b$ | |
| Box2.Text = "" | |
| Box1.Text = "" | |
| Selection.Autofilter | |
| f = 3 | |
| a = Box1.Text | |
| b = Box2.Text | |
| Selection.Autofilter Field:=f, Criteria1:=a | |
| Call aktivieren | |
| End | |
| End Sub | |
| |
| Private Sub cmdMappen_Click() | Zwischen ArbeitsMappen umschalten. |
| ActiveWindow.ActivateNext | |
| End Sub | |
| |
| Private Sub cmdLevel_Click() | Level suchen. |
| Dim x$, a$, f% | |
| x = InputBox("Welchen Level suchen Sie?") | |
| If x <> "" Then Selection.Autofilter | |
| f = 4 | |
| a = x | |
| Selection.Autofilter Field:=f, Criteria1:=a | |
| Call aktivieren | |
| End | |
| End Sub | |
| Unterprogramm für alle Steuerelemente. |
| Private Sub entladen(ByVal KeyAscii As MSForms.ReturnInteger) |
| If KeyAscii = 27 Then Unload Me | 27 = Esc-Taste |
| If KeyAscii = 2 Then | 2 = Strg + b (beenden) |
| Selection.Autofilter | |
| Unload Me | |
| End If | |
| End Sub | |
| |
| Private Sub cmdSortier_Click() | Sortiert das Arbeitsblatt (zuerst Spalte D, dann E). |
| Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("E2"), Order2:=xlAscending, _ |
| Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom |
| Call aktivieren | |
| End | |
| End Sub | |
| |
| Private Sub UserForm_Terminate() | Zwei Worksheet-Zellen erhalten den Inhalt der beiden |
| ActiveSheet.Range("H2").Value = Box1.Text | TextBoxen, wenn das Programm beendet wird. |
| ActiveSheet.Range("H3").Value = Box2.Text | |
| End Sub | |
| |
| Private Sub Butt1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) |
| Call entladen(ByVal KeyAscii) | Call Entladen gilt auch für alle anderen Steuerelemente. |
| End Sub | |
| |
| Private Sub Opt1_Click() | |
| Call boxx1 | Call boxx1 gilt auch für alle anderen OptionButton. |
| Box1.SetFocus | |
| End Sub | |
| |
| Diese Prozedur kopiert den Inhalt aller Arbeitsblätter auf ein neues Blatt: |
| Private Sub Kopieren() | |
| anzahl = ActiveWorkbook.Worksheets.Count | Stellt die Menge der ArbeitsBlätter fest. |
| ActiveWorkbook.Worksheets.Add | Fügt ein neues ArbeitsBlatt hinzu. |
| ActiveSheet.Name = "Gesamt" | Vergibt Namen für neues Arbeitsblatt. |
| For i = 1 To anzahl + 1 | Durchläuft alle Arbeitsblätter (um zu kopieren). |
| Worksheets(i).Activate | Aktiviert ein ArbeitsBlatt nach dem anderen. |
| If ActiveSheet.Name = "Gesamt" Then GoTo 10 | Wenn letztes Blatt erreicht ist, GeheZu Zeile 10. |
| ActiveCell.CurrentRegion.Select | Wählt Bereiche aus. |
| Selection.Copy | Kopiert gewählten Bereich. |
| Worksheets("Gesamt").Select | Wählt neues ArbeitsBlatt aus. |
| ActiveSheet.Paste | Fügt Werte in neues ArbeitsBlatt ein. |
| ActiveCell.CurrentRegion.Select | Wählt Bereich aus. |
| z = Selection.Rows.Count | Zählt die besetzten Zeilen. |
| Cells(z + 1, 1).Activate | Erweitert den Bereich, um Kopiertes dranzuhängen. |
| 10 | |
| Next | Beendet die Programmschleife. |
| Range("a1").Select | Geht zur Zelle A1. |
| Abfrage.Show | Startet das Formular Abfrage. |
| End Sub | |
| |
 | |
| |
| |
| |
| |
| |
| |
| . |
| |
zurück