Office: Filtern mit Userform

derhard · 30. Juli 2016

Hallo zusammen,
Bitte um VBA Hilfe!
Wie kann in der beigefügten Testmappe das Textfeld mit einem VBA Code
erstellt werden, sodass bei Eingabe eines Suchbegriffs z.B *Caliper
(der Begriff ist in der Spalte Description vorhanden) die entsprechenden Zeilen
gefiltert werden?
Dannach sollten die gefilterten Zeilen in die Mappe "Filterdaten" übernommen
werden.
Nach einer weiteren Eingabe eines anderen Suchbegriffs sollten die Filtergebnisse in die Mappe "Filterdaten" an die nächste freie Stelle angefügt
werden!
Bevor die Filterergenisse in die Mappe "Filterdaten" übernommen werden sollte
vorher eine zu bestätigende Abfrage erfolgen
z.B "Sollen die gefilterten Daten übernommen werden" mit Ja oder Nein quittieren!

Vielen Dank für Eure Hilfe
Gruß Derhard

:)

erpe · 1. August 2016

Hallo Derhard,

Mappe "Filterdaten"
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

= Tabelle Filterdaten?

Zur Lösung: Hier bietet sich der Spezialfilter an.
Kopiere die Überschrift aus Zeile 3 in die Tabelle Filterdaten.
Infos dazu findest Du hier: Online - Excel: Spezialfilter (2) - Filtern nach Kriterien

Unter dem Feldnamen erstellst Du ein Dropdownfeld >>> Daten Güligkeit mit dem Du die Kriterien leicht auswählen kannst. Unbedingt Name definieren!
Infos dazu hier: Online - Excel: Datenüberprüfung - Gültigkeit (1) - Grundlagen

Viel Erfolg
Gruß
Rainer

Beverly · 1. August 2016

Hi Derhard,

ich würde es zwar mit dem Autofilter lösen, aber da du bereits einen umfangreichen Code für das "Filtern" erstellt hast, würde ich diesen wie folgt ergänzen/erweitern:

Code:

Private Sub CommandButton1_Click()
Dim lngRow As Long
Dim intSpalte As Integer
Dim blnKopieren As Boolean
Dim varAbfrage As Variant
Dim lngErste As Long
Dim lngLetzte As Long

Set rngHide = Nothing

With ActiveSheet
ActiveSheet.Rows.Hidden = False
For lngRow = 4 To Application.Max(4, .Cells(.Rows.Count, 1).End(xlUp).Row)
If optDateSel Then
If Not IsDate(.Cells(lngRow, 8)) Then
addRange .Cells(lngRow, 8)
Else
If .Cells(lngRow, 8) < CDate(txtDateFrom) Or .Cells(lngRow, 8) > CDate(txtDateTo) Then
addRange .Cells(lngRow, 8)
End If
End If
End If
If optDescrExcept Then
If LCase(.Cells(lngRow, 6)) Like "knu*" Or LCase(.Cells(lngRow, 6)) Like "str*" Or LCase(.Cells(lngRow, 6)) Like "whe*" Then
addRange .Cells(lngRow, 6)
End If
ElseIf optDescrKNU Then
If Not LCase(.Cells(lngRow, 6)) Like "knu*" Then
addRange .Cells(lngRow, 6)
End If
ElseIf optDescrSTR Then
If Not LCase(.Cells(lngRow, 6)) Like "str*" Then
addRange .Cells(lngRow, 6)
End If
ElseIf optDescrWHE Then
If Not LCase(.Cells(lngRow, 6)) Like "whe*" Then
addRange .Cells(lngRow, 6)
End If

ElseIf optDescrCal Then
If Not LCase(.Cells(lngRow, 6)) Like "*cali*" Then
addRange .Cells(lngRow, 6)
End If
End If
If optPoNmbr Then
If .Cells(lngRow, 1) Val(cboPONmbr.Text) Then
addRange .Cells(lngRow, 1)
End If
End If
If TextBox1 "" Then
For intSpalte = 1 To 7
If InStr(LCase(.Cells(lngRow, intSpalte)), LCase(TextBox1.Value)) > 0 Then
blnKopieren = True
Exit For
End If
Next intSpalte
If blnKopieren = False Then addRange .Cells(lngRow, 1)
blnKopieren = False
End If
Next
End With

If Not rngHide Is Nothing Then
lngLetzte = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
rngHide.Rows.Hidden = True
If Range(Cells(3, 1), Cells(lngLetzte, 1)).SpecialCells(xlCellTypeVisible).Count > 1 Then
varAbfrage = MsgBox("Daten kopieren?", vbOKCancel, "Kopierabfrage")
If varAbfrage = 1 Then
With Worksheets("Filterdaten")
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
.Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Range(Cells(4, 1), Cells(lngLetzte, 9)).SpecialCells(xlCellTypeVisible).Copy .Cells(lngErste, 1)
End With
End If
Else
MsgBox "Keine Daten vorhanden"
End If
Cells.Rows.Hidden = False
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Außerdem solltest du beim Aktivieren der TextBox alle OptionButton zurücksetzen, denn sonst würde der Code sowohl nach den gewählten OptionButton als auch nach dem TexxtBox-Inhalt suchen und damit wäre das Filterergebnis nicht korrekt

Code:

Private Sub TextBox1_Enter()
Dim ctrElement As Control
For Each ctrElement In Me.Controls
If TypeName(ctrElement) = "OptionButton" Then ctrElement.Value = False
Next ctrElement
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

derhard · 2. August 2016

Hallo Karin,
Vielen Dank für die Hilfe!
Ich habe mit deiner Lösung einige Test's gemacht und es wäre super wenn
du meine nachfolgenden Wünsche noch umsetzen könntest!

1.) Die Abfrage ob die gefilterten Daten kopiert werden sollen bitte herausnehmen und über einen Button im Bedarfsfall kopieren.

2.) Zusätzliche Suche über eine Auswahl von immer wiederkehrenden Suchbegriffen über Listbox.

Vielen Dank für deine Hilfe!
Gruß Derhard

derhard · 2. August 2016

Hallo Karin,
könntest Du Dir mein Problem nochmals anschauen und überarbeiten!

Vielen Dank
Gruß derhard

Beverly · 2. August 2016

Hi Derhard,

sorry, aber irgendwie ist mein Beitrag nicht im Forum angenommen worden - das ist mir leider nicht aufgefallen.

Zu 1.: lösche den folgenden Codeteil (einschließlich der betreffenden Variablendeklarationen) aus dem CommandButton1 und schribe ihn in den CommandButton5:

Code:

Private Sub CommandButton5_Click()
Dim varAbfrage As Variant
Dim lngErste As Long
Dim lngLetzte As Long
If Not rngHide Is Nothing Then
lngLetzte = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
rngHide.Rows.Hidden = True
If Range(Cells(3, 1), Cells(lngLetzte, 1)).SpecialCells(xlCellTypeVisible).Count > 1 Then
varAbfrage = MsgBox("Daten kopieren?", vbOKCancel, "Kopierabfrage")
If varAbfrage = 1 Then
With Worksheets("Filterdaten")
lngErste = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
.Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count) + 1
Range(Cells(4, 1), Cells(lngLetzte, 9)).SpecialCells(xlCellTypeVisible).Copy .Cells(lngErste, 1)
End With
End If
Else
MsgBox "Keine Daten vorhanden"
End If
Cells.Rows.Hidden = False
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Zu 2.: wie und wann soll denn die ListBox gefüllt werden? Ich nehme an wenn der Schalter "Filtern" gedrückt wurde und zwar nur die Inhalte der TextBox, zu deren Recherche Treffer gefunden wurden?

derhard · 3. August 2016

Hallo Karin,
ich habe mal nach deiner Anweisung die Abfrage so übernommen.
Jetzt muss ich nach Eingabe oder Auswahl eines Filterkriteriums zuerst den Button Filtern und dann den Button5 Filterdaten kopieren drücken dass die Filterung beginnt??
Es sollte so ablaufen:
Nach Eingabe oder Auswahl des Kriteriums sollte nach Drücken des Button
Filter danach gefiltert und zur Anzeige in der Tabelle VA05 durchgeführt werden!
(noch besser wäre, wenn nach Eingabe eines Kriteriums direkt zeitgleich die Filterung startet)
Jetzt entscheide ich ob die gefilterten Daten über eine Ja/Nein Abfrage mit Button5 in die Tabelle Filterdaten übernommen werden sollen!

Zu 2)
Die Listbox1 sollte mit den in der Tabelle Suchbegriffe (werden noch erweitert) hinterlegten Suchkriterien nach öffnen der Userform1 gefüllt werden.
Nach Auswahl eines Kriteriums aus der Listbox sollte ebenfalls gefiltert werden können.
Für weitere Rückfragen stehe ich gerne zur Verfügung.

Vielen Dank Gruß Derhard

Beverly · 3. August 2016

Hi Derhard,

ergänze vor End With für den CommandButton1 diese Zeile, damit gleich gefitert wird, wenn er gedrückt wird:

Code:

If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Für das Filtern bei Eingabe in die TextBox:

Code:

Private Sub TextBox1_Change()
Dim lngLetzte As Long
Dim lngZeile As Long
Dim intSpalte As Integer
Dim blnKopieren As Boolean
With Worksheets("VA05")
If TextBox1 "" Then
lngLetzte = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For lngZeile = 4 To lngLetzte
For intSpalte = 1 To 7
If InStr(LCase(.Cells(lngZeile, intSpalte)), LCase(TextBox1.Value)) > 0 Then
blnKopieren = True
Exit For
End If
Next intSpalte
If blnKopieren = False Then addRange .Cells(lngZeile, 1)
blnKopieren = False
Next lngZeile
If Not rngHide Is Nothing Then rngHide.Rows.Hidden = True
Else
.Cells.Rows.Hidden = False
End If
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Für das Füllen der ListBox ergänze das Activate-Ereignis:

Code:

Private Sub UserForm_Activate()
Dim vntList As Variant
Dim lngLetzte As Long
With ActiveSheet
.Cells.Rows.Hidden = False
vntList = .Range(.Cells(4, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
cboPONmbr.List = toArraySorted(vntList)
End With
With Worksheets("Suchbegriffe")
lngLetzte = .Columns(1).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
ListBox1.RowSource = "Suchbegriffe!" & Range(Cells(1, 1), Cells(lngLetzte, 1)).Address
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Außerdem dein Code etwas geändert - kein On Error Resume Next notwendig.

Damit bei Auswahl eines ListBox-Eintrages gefiltert wird:

Code:

Private Sub ListBox1_Click()
Dim lngLetzte As Long
Dim lngZeile As Long
Dim intSpalte As Integer
Dim blnKopieren As Boolean
With Worksheets("VA05")
.Cells.Rows.Hidden = False
Set rngHide = Nothing
lngLetzte = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For lngZeile = 4 To lngLetzte
For intSpalte = 1 To 7
If InStr(LCase(.Cells(lngZeile, intSpalte)), LCase(ListBox1.Value)) > 0 Then
blnKopieren = True
Exit For
End If
Next intSpalte
If blnKopieren = False Then addRange .Cells(lngZeile, 1)
blnKopieren = False
Next lngZeile
If Not rngHide Is Nothing Then rngHide.Rows.Hidden = True
End With
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

derhard · 3. August 2016

Hallo Karin,

Vielen Vielen Dank für deine Super Hilfe!!!!

Die ersten Test schauen alle soweit gut aus bis auf:
wenn man in Listbox ein Krieterium zum Suchen ausgewählt und daraufhin gefiltert wurde wird anschließend bei manueller Eingabe in Textbox keine Filterung durchgeführt!

Gruß Derhard

Beverly · 3. August 2016

Hi Derhard,

teste es mal jetzt.

Office: Filtern mit Userform

Filtern mit Userform

Filtern mit Userform

Filtern mit Userform

Filtern mit Userform

Filtern mit Userform - Similar Threads - Filtern Userform

Intelligente Tabelle Filter fixieren

neue Filter Funktion

Filter Formel geht nicht

SQL: Filtern mit mehreren Werten aus einer Excelspalte (Liste)

Userform mit Filtern

Per Userform Tabellenblätter anwählen und filter setzen ausgabe in eine Listbox

VBA: Userform - KW bestimmen - Wert filtern - Werte zählen - Werte eintragen