Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1600to1604
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

3 Filter in Listbox einbauen

3 Filter in Listbox einbauen
18.01.2018 08:36:12
Andy
Hallo alle zusammen,
mein VBA ist wirklich bescheiden. Ich arbeite schon seit Wochen an dieser Datei und habe viele Codeschnipsel zusammengebaut - danke an dieser Stelle auch an all diejenigen, die mir schon geholfen haben.
Es stellt sich jetzt folgendes Problem. Ich habe ein Userform erstellt, in der viele Mitarbeiter eingetragen werden können, in der Eintragungen zu verschiedenen Seminaren stehen, usw. Es wird leider für die Anwender unübersichtlich, weshalb ich jetzt drei Filter einrichten möchte, nach dem dann die Listbox sortiert werden kann.
Die Filter heißen FilterBox1, FilterBox2 und FilterBox3.
Ist jemand in der Lage mir meinen Code so umzubauen, dass ich danach die Filter auf die Spalte 2 (FilterBox1) und 3 (FilterBox2) und 10 (FilterBox3) umbauen kann. Bei 3 steht immer ein Datum drinnen. z.b. 25.03.2017, 18.04.2017, usw. Dort würde ich gerne in FilterBox2 das so haben wollen, dass ich den Monat 'März" auswählen kann und danach dann alle Daten aus März erscheinen. Also eine Filterung nach Monat.
Wäre wirklich sehr dankbar für eine Hilfe.
Hier der Code:
Option Explicit
Option Compare Text
'In welcher Zeile starten die Eingaben?
Private Const lCONST_STARTZEILENNUMMER_DER_TABELLE As Long = 3
'Neuer Eintrag Schaltfläche Ereignisroutine
Private Sub CommandButton1_Click()
Call EINTRAG_ANLEGEN 'Aufruf der entsprechenden Verarbeitungsroutine
End Sub
'Löschen Schaltfläche Ereignisroutine
Private Sub CommandButton2_Click()
Call EINTRAG_LOESCHEN 'Aufruf der entsprechenden Verarbeitungsroutine
End Sub
'Speichern Schaltfläche Ereignisroutine
Private Sub CommandButton3_Click()
Call EINTRAG_SPEICHERN 'Aufruf der entsprechenden Verarbeitungsroutine
End Sub
'Beenden Schaltfläche Ereignisroutine
Private Sub CommandButton4_Click()
' Call EINTRAG_SPEICHERN
'Tabelle vor dem Schließen nach Datum sortieren
Range("A3:AX1000").Sort _
Key1:=Range("A3"), Order1:=xlAscending, _
Key2:=Range("B3"), Order2:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Formular verlassen
Unload Me
End Sub

'Klick auf die ListBox Ereignisroutine
Private Sub ListBox1_Click()
Call EINTRAG_LADEN_UND_ANZEIGEN 'Aufruf der entsprechenden Verarbeitungsroutine
End Sub
'Diese Ereignisroutine wird beim Anzeigen der UserForm ausgeführt
Private Sub UserForm_Activate()
If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0 '1. Eintrag selektieren
End Sub

Private Sub UserForm_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Control As  _
MSForms.Control, ByVal Action As MSForms.fmAction, ByVal Data As MSForms.DataObject, ByVal x As Single, ByVal y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
End Sub
'Startroutine, wird ausgeführt bevor die Eingabemaske angezeigt wird
Private Sub UserForm_Initialize()
Call LISTE_LADEN_UND_INITIALISIEREN 'Aufruf der entsprechenden Verarbeitungsroutine
If Environ("Username") = Tabelle2.Cells(23, 3).Value Then
With Me.ComboBox1
.AddItem "in Planung"
.AddItem "beantragt"
.AddItem "genehmigt"
.AddItem "abgelehnt"
.AddItem "Genehmigung widerrufen"
.ListIndex = 1 'Vorbelegung bei Formularstart
End With
Else
With Me.ComboBox1
.AddItem "in Planung"
.AddItem "beantragt"
.AddItem "geändert"
'  .AddItem "genehmigt"
' .AddItem "abgelehnt"
' .AddItem "Genehmigung widerrufen"
.ListIndex = 1 'Vorbelegung bei Formularstart
End With
End If
With Me.FilterBox1
.AddItem "Alle"
.AddItem "A"
.AddItem "B"
.AddItem "C"
.AddItem "D"
.AddItem "E"
.ListIndex = 0 'Vorbelegung bei Formularstart
End With
With Me.FilterBox2
.AddItem "Januar"
.AddItem "Februar"
.AddItem "März"
.AddItem "April"
.AddItem "Mai"
.AddItem "Juni"
.AddItem "Juli"
.AddItem "August"
.AddItem "September"
.AddItem "Oktober"
.AddItem "November"
.AddItem "Dezember"
.ListIndex = 0 'Vorbelegung bei Formularstart
End With
With Me.FilterBox3
.AddItem "in Planung"
.AddItem "beantragt"
.AddItem "genehmigt"
.AddItem "abgelehnt"
.AddItem "Genehmigung widerrufen"
.ListIndex = 0 'Vorbelegung bei Formularstart
End With
'Labels der Mitarbeiter benennen - Bezug auf Tabellenblatt Einstellungen - DORT PFLEGEN
Dim sVersion As String
Me.Label_Benutzer = "Benutzer: " & Application.UserName
Me.Label_USBNK = "USBNK    : " & Environ("Username")
'Dienstgruppe A
CheckBox1.Caption = Tabelle2.Range("A4")
CheckBox2.Caption = Tabelle2.Range("A5")
CheckBox3.Caption = Tabelle2.Range("A6")
CheckBox4.Caption = Tabelle2.Range("A7")
CheckBox5.Caption = Tabelle2.Range("A8")
'Dienstgruppe B
CheckBox6.Caption = Tabelle2.Range("B4")
CheckBox7.Caption = Tabelle2.Range("B5")
CheckBox8.Caption = Tabelle2.Range("B6")
CheckBox9.Caption = Tabelle2.Range("B7")
CheckBox10.Caption = Tabelle2.Range("B8")
'Dienstgruppe C
CheckBox11.Caption = Tabelle2.Range("C4")
CheckBox12.Caption = Tabelle2.Range("C5")
CheckBox13.Caption = Tabelle2.Range("C6")
CheckBox14.Caption = Tabelle2.Range("C7")
CheckBox15.Caption = Tabelle2.Range("C8")
'Dienstgruppe D
CheckBox16.Caption = Tabelle2.Range("D4")
CheckBox17.Caption = Tabelle2.Range("D5")
CheckBox18.Caption = Tabelle2.Range("D6")
CheckBox19.Caption = Tabelle2.Range("D7")
CheckBox20.Caption = Tabelle2.Range("D8")
'Dienstgruppe E
CheckBox21.Caption = Tabelle2.Range("E4")
CheckBox22.Caption = Tabelle2.Range("E5")
CheckBox23.Caption = Tabelle2.Range("E6")
CheckBox24.Caption = Tabelle2.Range("E7")
CheckBox25.Caption = Tabelle2.Range("E8")
'Nezugänge
CheckBox26.Caption = Tabelle2.Range("F4")
CheckBox27.Caption = Tabelle2.Range("F5")
CheckBox28.Caption = Tabelle2.Range("F6")
CheckBox29.Caption = Tabelle2.Range("F7")
CheckBox30.Caption = Tabelle2.Range("F8")
'Praktikanten
CheckBox31.Caption = Tabelle2.Range("G4")
CheckBox32.Caption = Tabelle2.Range("G5")
CheckBox33.Caption = Tabelle2.Range("G6")
CheckBox34.Caption = Tabelle2.Range("H4")
CheckBox35.Caption = Tabelle2.Range("H5")
CheckBox36.Caption = Tabelle2.Range("H6")
CheckBox37.Caption = Tabelle2.Range("I4")
CheckBox38.Caption = Tabelle2.Range("I5")
CheckBox39.Caption = Tabelle2.Range("I6")
CheckBox40.Caption = Tabelle2.Range("J4")
CheckBox41.Caption = Tabelle2.Range("J5")
CheckBox42.Caption = Tabelle2.Range("J6")
CheckBox43.Caption = Tabelle2.Range("K4")
CheckBox44.Caption = Tabelle2.Range("K5")
CheckBox45.Caption = Tabelle2.Range("K6")
Label_Benutzer = "Benutzer: " & Application.UserName
Label_USBNK = "USBNK    : " & Environ("Username")
Label17.Caption = Tabelle2.Range("B21") & " - " & Tabelle2.Range("A21")
Label18.Caption = Tabelle2.Range("B22") & " - " & Tabelle2.Range("A22")
Label19.Caption = Tabelle2.Range("B23") & " - " & Tabelle2.Range("A23")
Label20.Caption = Tabelle2.Range("B24") & " - " & Tabelle2.Range("A24")
Label21.Caption = Tabelle2.Range("B25") & " - " & Tabelle2.Range("A25")
Label22.Caption = Tabelle2.Range("B26") & " - " & Tabelle2.Range("A26")
Label23.Caption = Tabelle2.Range("B27") & " - " & Tabelle2.Range("A27")
Label24.Caption = Tabelle2.Range("B28") & " - " & Tabelle2.Range("A28")
Label25.Caption = Tabelle2.Range("B29") & " - " & Tabelle2.Range("A29")
DoEvents
End Sub

'Diese Routine wird aufgerufen um die Liste (ListBox1) zu leeren, einzustellen und neu zu füllen
Private Sub LISTE_LADEN_UND_INITIALISIEREN()
Dim lZeile As Long
Dim lZeileMaximum As Long
Dim i As Integer
'Alle TextBoxen leer machen
For i = 1 To 6
Me.Controls("TextBox" & i) = ""
Next i
'Liste leeren
ListBox1.Clear
'Anzahl der Spalten einrichten, wobei Spalte 1: Zeilennummer des Datensatzes, Spalte 2: A,  _
Spalte 3: B....
ListBox1.ColumnCount = 7
'Spaltenbreiten der Liste anpassen (0=ausblenden, nichts=automatisch)
ListBox1.ColumnWidths = "0;12;50;30;30;130;"
'Um eine Schleife für alle Datensätze zu erhalten benötigen wir die letzte verwendete Zeile
lZeileMaximum = Tabelle1.UsedRange.Rows.Count + 1 'Benutzer Bereich auslesen
For lZeile = lCONST_STARTZEILENNUMMER_DER_TABELLE To lZeileMaximum
'Nur wenn die Zeile benutzt / nicht leer ist, zeigen wir etwas an:
If IST_ZEILE_LEER(lZeile) = False Then
'Spalte 1 der Liste mit der Zeilennummer füllen
ListBox1.AddItem lZeile
'Spalten 2 und fortfolgende in der Liste füllen
ListBox1.List(ListBox1.ListCount - 1, 1) = CStr(Tabelle1.Cells(lZeile, 1).Text) '2. _
Seminar
ListBox1.List(ListBox1.ListCount - 1, 2) = CStr(Tabelle1.Cells(lZeile, 2).Text) '3. _
Datum
ListBox1.List(ListBox1.ListCount - 1, 3) = CStr(Tabelle1.Cells(lZeile, 3).Text) '4. _
Beginn
ListBox1.List(ListBox1.ListCount - 1, 4) = CStr(Tabelle1.Cells(lZeile, 4).Text) '5. _
Ende
ListBox1.List(ListBox1.ListCount - 1, 5) = CStr(Tabelle1.Cells(lZeile, 5).Text) '6. _
Beschreibung
ListBox1.List(ListBox1.ListCount - 1, 6) = CStr(Tabelle1.Cells(lZeile, 9).Text) '7. _
Status
End If
Next lZeile
End Sub
Private Sub EINTRAG_LADEN_UND_ANZEIGEN()
Dim lZeile As Long
Dim i As Integer
'Eingabefelder resetten
For i = 1 To 6
Me.Controls("TextBox" & i) = ""
Next i
'Nur wenn ein Eintrag selektiert/markiert ist
If ListBox1.ListIndex >= 0 Then
'Die Zeilennummer des Datensatzes steht in der ersten ausgeblendeten Spalte der Liste,  _
somit können wir direkt zugreifen.
lZeile = ListBox1.List(ListBox1.ListIndex, 0)
For i = 1 To 6
Me.Controls("TextBox" & i) = CStr(Tabelle1.Cells(lZeile, i + 1).Text)
Next i
For i = 1 To 1
On Error Resume Next
Controls("ComboBox" & CStr(i)).Value = Cells(lZeile, i + 8).Value
Next
For i = 1 To 5
Me.Controls("OptionButton" & CStr(i)).Value = Cells(lZeile, i + 10).Value = " _
Seminar"
Next
For i = 1 To 45
Me.Controls("Checkbox" & CStr(i)).Value = Cells(lZeile, i + 15).Value = "Seminar"
Next
End If
End Sub
Private Sub EINTRAG_SPEICHERN()
Dim lZeile As Long
Dim i As Integer
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Zum Speichern benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = ListBox1.List(ListBox1.ListIndex, 0)
'Einträge werden Spalte für Spalte abgespeichert
Tabelle1.Cells(lZeile, 1).FormulaLocal = "=WENNFEHLER(CollectNames($K$2:$O$2;""""); """" _
)"
If TextBox1.Value = "" Then TextBox1.Value = Format(Now, "DD.MM.YYYY")
Tabelle1.Cells(lZeile, 2).Value = CDate(TextBox1.Text)
For i = 2 To 6
If TextBox4.Value = "" Then TextBox4.Value = "--- EINTRAG FEHLERHAFT ---"
Tabelle1.Cells(lZeile, i + 1) = Me.Controls("TextBox" & i)
Next i
Tabelle1.Cells(lZeile, 8).FormulaLocal = "=WENNFEHLER(CollectNames($P$2:$BH$2;"", ""); " _
""")"
Tabelle1.Cells(lZeile, 9).Value = Controls("ComboBox" & CStr(1)).Text
Tabelle1.Cells(lZeile, 10).Value = Format(Now, "DD.MM.YYYY hh:mm") & ", " & Environ(" _
Username")
For i = 1 To 5
Tabelle1.Cells(lZeile, i + 10).Value = IIf(Controls("OptionButton" & CStr(i)).Value, " _
Seminar", "")
Next
For i = 1 To 45
Tabelle1.Cells(lZeile, i + 15).Value = IIf(Controls("Checkbox" & CStr(i)).Value, " _
Seminar", "")
Next
'Der Benutzer könnte die angezeigten Werte in der Liste geändert haben,
'daher aktualisieren wir den ausgewählten Eintrag entsprechend.
ListBox1.List(ListBox1.ListIndex, 1) = Cells(lZeile, 1).Value
ListBox1.List(ListBox1.ListIndex, 2) = TextBox1
ListBox1.List(ListBox1.ListIndex, 3) = TextBox2
ListBox1.List(ListBox1.ListIndex, 4) = TextBox3
ListBox1.List(ListBox1.ListIndex, 5) = TextBox4
ListBox1.List(ListBox1.ListIndex, 6) = ComboBox1
ListBox1.List(ListBox1.ListIndex, 7) = Cells(lZeile, 1).Value
End Sub
Private Sub EINTRAG_LOESCHEN()
Dim lZeile As Long
'Wenn kein Datensatz in der ListBox markiert wurde, wird die Routine beendet
If ListBox1.ListIndex = -1 Then Exit Sub
'Beim Löschen fragen wir zuerst den Benutzer noch einmal sicherheitshalber:
If MsgBox("Sie möchten den Datensatz wirklich löschen?", _
vbQuestion + vbYesNo, "Sicherheitsabfrage!") = vbYes Then
'Nur wenn er mit  antwortet, löschen wir auch!
'Zum Löschen benötigen wir die Zeilennummer des ausgewählten Datensatzes
lZeile = ListBox1.List(ListBox1.ListIndex, 0)
'Die ganze Zeile wird nun gelöscht
Tabelle1.Rows(CStr(lZeile & ":" & lZeile)).Delete
'Und den Eintrag in der Liste müssen wir auch noch entfernen
ListBox1.RemoveItem ListBox1.ListIndex
End If
End Sub
Private Sub EINTRAG_ANLEGEN()
Dim lZeile As Long
lZeile = lCONST_STARTZEILENNUMMER_DER_TABELLE
'Schleife bis eine leere ungebrauchte Zeile gefunden wird
Do While IST_ZEILE_LEER(lZeile) = False
lZeile = lZeile + 1 'Nächste Zeile bearbeiten
Loop
'Nach Durchlauf dieser Schleife steht lZeile in der ersten leeren Zeile von Tabelle1
'Tabelle1.Cells(lZeile, 2) = "06:30"
'Tabelle1.Cells(lZeile, 3) = "12:30"
'Und neuen Eintrag in die UserForm eintragen
ListBox1.AddItem lZeile
ListBox1.List(ListBox1.ListCount - 1, 5) = "Bitte neues Seminar erfassen ---->"
'Den neuen Eintrag markieren mit Hilfe des ListIndex
ListBox1.ListIndex = ListBox1.ListCount - 1
'Durch das Click Ereignis der ListBox werden die Daten automatisch geladen Und dem Benutzer  _
direkt
'noch den Cursor in das erste Eingabefeld stellen und alles vorselektieren, so kann der  _
Benutzer direkt loslegen mit der Dateneingabe.
TextBox4.SetFocus
TextBox4.SelStart = 0
TextBox4.SelLength = Len(TextBox4)
TextBox1.Text = ""
TextBox2.Text = "06:30"
TextBox3.Text = "12:30"
TextBox4.Text = ""
TextBox5.Text = ""
TextBox6.Text = "09:30"
ComboBox1.Text = "in Planung"
End Sub

' ************************************************************************************************
' HILFSFUNKTIONEN
' ************************************************************************************************
'Ermittelt, ob eine Zeile in Benutzung ist...
Private Function IST_ZEILE_LEER(ByVal lZeile As Long) As Boolean
Dim i As Long
Dim sTemp As String
'Hilfsvariable initialisieren
sTemp = ""
'Um zu erkennen, ob eine Zeile komplett leer/ungebraucht ist
'verketten wir einfach alle Spalteninhalte der Zeile miteinander.
'Ist die zusammengesetzte Zeichenkette aller Spalten leer,
'ist die Zeile nicht genutzt...
For i = 1 To 9
sTemp = sTemp & Trim(CStr(Tabelle1.Cells(lZeile, i).Text))
Next i
'Rückgabewert festlegen
If Trim(sTemp) = "" Then
'Die Zeile ist leer
IST_ZEILE_LEER = True
Else
'Die Zeile ist mindestens in einer Spalte gefüllt
IST_ZEILE_LEER = False
End If
End Function

'Überprüfen der Eingabefelder auf Ihre Gültigkeit/ Richtigkeit
Private Sub Textbox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case Len(TextBox1)
Case 0
Select Case KeyAscii
Case 48 To 51
Case Else
KeyAscii = 0
End Select
Case 1
If CLng(TextBox1) > 2 Then
Select Case KeyAscii
Case 48, 49
Case Else: KeyAscii = 0
End Select
Else
Select Case KeyAscii
Case 48 To 57
Case Else: KeyAscii = 0
End Select
End If
Case 2, 5
Select Case KeyAscii
Case 44, 46, 47: KeyAscii = 46
Case Else: KeyAscii = 0
End Select
Case 3
Select Case KeyAscii
Case 48, 49
Case Else: KeyAscii = 0
End Select
Case 4
If CLng(Mid(TextBox1, 4, 1)) = 0 Then
Select Case KeyAscii
Case 48 To 57
Case Else: KeyAscii = 0
End Select
Else
Select Case KeyAscii
Case 48 To 50
Case Else: KeyAscii = 0
End Select
End If
Case 6 To 10
Select Case KeyAscii
Case 48 To 57
Case Else: KeyAscii = 0
End Select
Case Else: KeyAscii = 0
End Select
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(Me.TextBox2.Value) Then
Me.TextBox2.Value = Format(Me.TextBox2.Value, "HH:MM")
Else
MsgBox "Bitte eine gültige Uhrzeit eingeben!"
Cancel = True
End If
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(Me.TextBox2.Value) Then
Me.TextBox2.Value = Format(Me.TextBox2.Value, "HH:MM")
Else
MsgBox "Bitte eine gültige Uhrzeit eingeben!"
Cancel = True
End If
End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(Me.TextBox3.Value) Then
Me.TextBox3.Value = Format(Me.TextBox3.Value, "HH:MM")
Else
MsgBox "Bitte eine gültige Uhrzeit eingeben!"
Me.TextBox3.Value = ""
Cancel = True
End If
End Sub

Private Sub TextBox6_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsDate(Me.TextBox6.Value) Then
Me.TextBox6.Value = Format(Me.TextBox6.Value, "HH:MM")
Else
MsgBox "Bitte eine gültige Uhrzeit eingeben!"
Me.TextBox6.Value = ""
Cancel = True
End If
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Musterdatei?
18.01.2018 08:39:32
UweD
AW: Musterdatei?
18.01.2018 08:57:51
Andy
Habe soeben versucht sensible Daten daraus zu entfernen. Ich würde es ja gerne hochladen, nur das ist alles so komplex verschachtelt, dass ich leider keine Musterdatei hochladen kann. Da sind viele Berechtigungen hinterlegt, die nur lokal öffenbar sind.
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige