Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1632to1636
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

Spezialfilter/Autofilter

Spezialfilter/Autofilter
06.07.2018 15:33:22
Sandro
Hallo Leute,
mit dem Makrorecorder habe ich die unten stehenden Vorgänge aufgezeichnet. Allerdings möchte ich nach mehr als nur den 2 Kriterien "mat9" und "cat9" suchen sondern möchte insgesamt 4 Kriterien ("mat9", "cat9", "usb9", "lwl9") nutzen (was der einfache Autofilter ja nicht beherrscht). Ich habe gelesen, dass ich das mit einem Array lösen kann, allerdings bin ich mit Arrays sehr unbeholfen und weiß nicht so recht wo ich den in diesem Code dann einbauen sollte. Der unten zitierte Code löscht letzendlich alle Spalten, warum verstehe ich nicht. Code siehe im VBA-Bereich der Datei.
Vielen Dank im Voraus und viele Grüße
Sandro
 Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("C:EZ").Select
Selection.Delete Shift:=xlToLeft
Columns("A:A").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$A$10918").AutoFilter Field:=1, Criteria1:=Array("mat9", "cat9", "  _
_
usb9", "lwl9"), Operator:=xlFilterValues
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tabelle1").Sort
.SetRange Range("A43:B10909")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub 

https://www.herber.de/bbs/user/122513.xlsm

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spezialfilter/Autofilter
06.07.2018 15:35:53
Rob
Ich habe Dir in Deinem ersten Thread bereits geantwortet. Warum postest Du eigentlich dieselbe Frage innerhalb kürzester Zeit 2x hintereinander?
AW: Spezialfilter/Autofilter
07.07.2018 10:21:11
Sandro
Wenn du genau liest, hab ich deinen Tipp beherzigt, aber es klappt trotzdem nicht wie es soll und da ich vergessen habe, eine Beispieldatei anzuhängen, habe ich das auch direkt getan.
Viele Grüße und ein schönes gut gelauntes Wochenende.
Sandro
AW: Spezialfilter/Autofilter
08.07.2018 20:59:18
Rob
Die Lösung von Daniel mit dem Array ist eleganter aber mein ist vllt einfacher zu verstehen, wenn Du mit dem Recorder arbeitest. Füge eine Hilfsspalte rechts neben der Suchspalte hinzu und zähle mit der Instr-Methode jedes Filter-Kriterium. Anschließend kannst Du alle nicht-leeren Zellen filtern:

Sub AutoFilterMulitpleCriterias()
Dim r As Range
For Each r In UsedRange.Range("G2:G" & Cells(Rows.Count, 7).End(xlUp).Row)
If Not InStr(r, "mat9") = 0 Or Not InStr(r, "cat9") = 0 Or Not InStr(r, "mat9") = 0 Or  _
Not InStr(r, "lwl9") = 0 Then
r.Offset(0, 1) = 1
End If
Next r
Range("H1:H" & Cells(Rows.Count, 7).End(xlUp).Row).AutoFilter Field:=1, Criteria1:=""
End Sub

Anzeige
AW: Spezialfilter/Autofilter
07.07.2018 11:48:14
Daniel
Hi
wenn du Code mit dem Recorder aufzeichnest, solltest du diesen IMMER hinterher überarbeiten (vorallem, wenn du möchstest, dass jemand fremdes sich den Code anschaut, analysiert und dir hilft)
Wir Mausschubser müssen wenn wir einen Befehl auf ein Objekt/Zellbereich anwenden wollen, immer zuerst da Objekt auswählen und in einem zweiten Schritt dann den Befehl. Das zeichnet der Recorder dann auch so auf.
IN VBA ist das nicht notwendig, hier kann man den Befehl direkt auf das Objekt anwenden und aus:
      Columns("F:F").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("C:EZ").Select
Selection.Delete Shift:=xlToLeft
wird
      Columns("F:F").Cut
Columns("A:A").Insert Shift:=xlToRight
Columns("C:EZ").Delete Shift:=xlToLeft

das ist nicht nur kürzer und übersichtlicher im Code, sondern auch schneller in der Ausführung.
zu deinen Problemen:
1. du verschiebst und löschst hier einfach wild irgendwelche Spalten, ohne zu prüfen, wo sich die zu verschiebenden Spalten überhaupt befinden.
Vorallem wenn du testest und die Spalten beim zweiten Testlauf schon verschoben wurden, löschst du dir sie einfach, weil sie dann in einem Bereich liegen den du löschst.
hier solltest du erstmal prüfen, wo die zu verschiebenden Spalten überhaupt liegen, einfach nur um sicher zu sein dass der Code keinen Blödsinn macht.
2. Sortiern in gefilterten Spalten ist unsinn. Normalerweise versucht Excel, ausgeblendete Zeilen nicht zu bearbeiten, aber beim Sortieren klappt das nicht.
Wenn sortiert werden soll, dann immer in ungefilterten Daten sortieren und hinterher sortieren.
3. Filtern mit Array
wenn du mehr als 2 Begriffe hast, die mit der Option "enthält" gefiltert werden sollen, dann wirds schwierig.
beim Filtern mit Array funktionieren die Joker * und ? nicht, dh das FilterArray muss jeden Wert, der angezeigt werden soll, mindestens einmal und vollständig enthalten.
hier mal der Code für deine Aufgabe
Sub xxx()
Dim rng As Range
Dim arr1, arr2
Dim z As Long
Dim txt
'--- Prüfen, ob Spalten schon in Position stehen
If Range("A1").Value  "ARTIKEL" Or Range("B1").Value  "AUFTRAGINDEX" Then
'--- Spalten anordnen mit Fehlerprüfung
Set rng = Rows(1).Find(what:="ARTIKEL", lookat:=xlWhole)
If rng Is Nothing Then
MsgBox "Spalte ARTIKEL fehlt"
Exit Sub
End If
rng.EntireColumn.Cut
Columns(1).Insert
Set rng = Rows(1).Find(what:="AUFTRAGINDEX", lookat:=xlWhole)
If rng Is Nothing Then
MsgBox "Spalte AUFTRAGINDEX fehlt"
Exit Sub
End If
rng.EntireColumn.Cut
Columns(2).Insert
Range(Columns(3), Columns(99)).Delete
End If
'--- Sortieren (Sortiercode aus Excel 2003, da kürzer als der neue,
Range("A:B").Sort Key1:=Range("A1"), order1:=xlAscending, Header:=xlYes
'--- Filterdaten ermitteln
arr2 = Range(Cells(2, 1), Cells(1, 1).End(xlDown)).Value
ReDim arr1(1 To UBound(arr2, 1))
For z = 1 To UBound(arr2, 1)
For Each txt In Array("mat9", "cat9", "usb9", "lwl9")
If InStr(arr2(z, 1), txt) > 0 Then
arr1(z) = arr2(z, 1)
Exit For
End If
Next
Next
'--- filtern
Range("A1").CurrentRegion.AutoFilter field:=1, Criteria1:=arr1, Operator:=xlFilterValues
End Sub
gruß Daniel
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige