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

Autofilter mit mehreren Kriterien in Zeichenabfolg

Autofilter mit mehreren Kriterien in Zeichenabfolg
14.11.2016 10:59:42
Mubi
Hallo zusammen,
ich habe gerade ein kleines Problem in VBA und konnte nach langer Suche noch keine Lösung finden.
Meine Datei besteht aus 2 Tabellen.
1. Tabelle stehen nur in Spalte A 180 Zeilen jeweils ein Code (A1: "RM7", A2: "X5G", A3:"R92", ...)
2. Tabelle besteht aus mehreren Spalten. In Spalte H bestehen die Zellen aus einer längeren Abfolge an Codes. Die Zelle aus folgendem Code (H1: "IT9 IR4 L GE2 RG8 RF1 RM7 RS3 Z2M D16 ES0 LF1 UB8")
Was ich versuche:
Ich möchte, dass mein Makro Zelle A1 aus Tabelle1 nimmt und überprüft, ob dieser Code in dem Codestrang von Tabelle2 H1 vorkommt. Danach das gleiche in H2, H3, usw. Hat er alle Zeilen durch, nimmt er sich aus Tabelle1 A2 und macht das gleiche nochmal.
Als Ergebnis gibt es 2 Varianten.
1. Autofilter setzen: er filtert nach allen Zeilen in denen der Code vorkommt
2. Sobald er den Code in Spalte H gefunden hat, soll in Spalte I eine 1 geschrieben werden, sonst eine 0. Wenn die 1. Schleife (im Bsp A1: "RM7") durch ist, muss sich die nächste Schleife nur noch mit den "0" befassen und überprüfen, ob der Code vorkommt (Es ist egal ob in einem Strang jeder Code vorkommt oder nur einer 1mal).
Ein Problem. Es sind insgesamt 250.000 Zeilen mit den langen Codes.
Ich hoffe ihr könnt mir weiterhelfen.

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Verständnisfrage
14.11.2016 11:15:22
Fennek
Hallo,
nur eine Frage: Könnte man Tab1:A1 als Suchwert in Tab2:Spalte H nutzen und alle Treffer mit "1" in Tab2:Spalte I markieren? Wie sollten dann Treffer mit dem Suchwert aus Tab1:A2 markiert werden?
mfg
AW: Verständnisfrage
14.11.2016 11:32:42
Mubi
Hallo,
die Treffer beim Suchkriterium Tabelle1 A2, sollen dann ebenfalls ins Spalte I mit 1 oder 0 dargestellt werden. Also die "0" von der vorherigen Suche überschrieben werden.
Viele Grüße
AW: Autofilter mit mehreren Kriterien in Zeichenabfolg
14.11.2016 15:53:48
Fennek
Hallo,
teste diesen Code:

Sub Mubi()
Dim rng As Range
lr1 = Tabelle1.Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Tabelle2.Cells(Rows.Count, "H").End(xlUp).Row
Tabelle2.Range("I1:I" & lr2) = 0
For i = 1 To lr1
Set rng = Tabelle2.Range("H2:H" & lr2).Find(Tabelle1.Cells(i, "A"), lookat:=xlPart)
If Not rng Is Nothing Then
Anf = rng.Address
Do
rng.Offset(, 1) = 1
Set rng = Tabelle2.Range("H2:H" & lr2).FindNext(rng)
Loop Until rng.Address = Anf
End If
Next i
End Sub
Es ist nicht so ganz einfach einen Code zu schreiben, ohne die Hintergründe zu verstehen.
Range.Find ist ein sehr schneller Befehl, also auch bei 250.000 Zeilen und 180 Suchbegriffen sollte es nicht viel länger als 10 Sekunden dauern.
mfg
Anzeige
AW: Autofilter mit mehreren Kriterien in Zeichenabfolg
14.11.2016 16:06:20
Mubi
Also das ist mein Code bzgl des Autofilters.
Sub test()
Dim Programm As Worksheet
Set Programm = Worksheets("Tabelle2")
With Programm
.AutoFilterMode = False
.Range("A1:I1").AutoFilter
.Range("A1:I1").AutoFilter Field:=9, Criteria1:=Array("*&RM7&*", "*&X5G&*", "*&R92&*"), _
Operator:=xlFilterValues
End With
End Sub
Er filtert mir nur keine Zeile, bzw ich bekomme es nicht hin, dass er in der Zeichenabfolge "IT9 IR4 L GE2 RG8 RF1 RM7 RS3 Z2M D16 ES0 LF1 UB8" dann RM7 erkennt und dann filtert.
@Fennek
Vielen Dank für deinen Code. Allerding kommen die Meldungen, dass viele Variablen noch nicht definiert sind.
Zum Hintergrund:
Es geht darum, dass ich 250.000 Teile habe. Der lange Code in Spalte H sind verschiedene Eigenschaften. Ich will jetzt die gesamte Anzahl Teile identifizieren, die meinen 180 Kriterien (z.B. Code RM7 ist Grün, UB8 ist 5cm,...) entsprechen, wobei es ausreicht, dass 1 Kriterium erfüllt ist.
Ich hoffe das der Sachverhalt jetzt eindeutiger geworden ist
Anzeige
AW: Autofilter mit mehreren Kriterien in Zeichenabfolg
14.11.2016 16:37:32
Fennek
Hallo,
die Fehlermeldungung entstehen, da ich keine "Option explicit" gesetzt habe.
Nach Augenschein sieht dein Code mit Autofilter gut aus (im Moment kann ich es nicht testen)
mfg
AW: Autofilter mit mehreren Kriterien in Zeichenabfolg
14.11.2016 17:03:54
Mubi
Das Problem bei meinem Code ist:
1. ich muss alle 180 Bedingungen manuell eintragen (hier habe ich es mit 3 getestet.
2. Die Ergebnisse sind falsch. Er filtert nur die Zellen, in denen nur der Suchcode drin ist. Sobald davor und danach weitere Code innerhalb der Zelle sind, findet er diese so nicht.
Viele Grüße
AW: Autofilter mit mehreren Kriterien in Zeichenabfolg
14.11.2016 17:12:57
Fennek
Hallo,
da die Codes in Tabelle1!Spalte A stehen, kann man sie mit

Ar = application.transpose(Tabelle1!Range("A1:A180")
in eine Array übernehmen und direkt in den Autofilter einsetzen.
mfg
Anzeige
AW: Autofilter mit mehreren Kriterien in Zeichenabfolg
15.11.2016 11:41:03
Mubi
Hallo,
das ist jetzt mein Code. Allerdings zeigt er mir bei "Ar = Array(Application.Transpose(Quelle.Range("A")))" den Laufzeitfehler 424 an, aber ich weiß gerade nicht welches Objekt gemeint ist bzw. was ich vergessen habe
Viele Grüße
Sub Finden()
Dim Programm As Worksheet
Dim Ar As String
Set Programm = Worksheets("Auftrag")
Ar = Array(Application.Transpose(Quelle.Range("A")))
With Programm
.AutoFilterMode = False
.Range("A1:I1").AutoFilter
ActiveSheet.Range("A1:I1").AutoFilter Field:=8, _
Criteria1:=Array("=*" & Ar & "*"), Operator:=xlFilterValues
End With
End Sub

Anzeige
AW: Autofilter mit mehreren Kriterien in Zeichenabfolg
15.11.2016 13:13:36
Fennek
Hallo,
"A" ist kein Range, versuche diese Kontruktion (nach Anpassen des Ranges)

Ar = Application.Transpose(Quelle.Range("A1:A180"))
mfg
PS: "Quelle" muss als Tabelle1 gesetzt sein mit
dim Quelle as worksheet
set Quelle = Sheets("Tabelle1")
AW: Autofilter mit mehreren Kriterien in Zeichenabfolg
15.11.2016 17:09:40
Mubi
Hallo,
ok habe die Range geändert.
Es wird mir immernoch ein Laufzeitfehler (jetzt 13) angezeigt. Irgendwie habe ich gerade einen Denkfehler. Also Quelle ist Tabellenblatt 1 und Auftrag ist Tabellenblatt 2
Viele Grüße
Sub Finden()
Dim Programm As Worksheet
Dim Quelle As Worksheet
Dim Ar As String
Set Quelle = Sheets("Quelle")
Set Programm = Worksheets("Auftrag")
Ar = Array(Application.Transpose(Quelle.Range("A1:A180")))
With Programm
.AutoFilterMode = False
.Range("A1:I1").AutoFilter
ActiveSheet.Range("A1:I1").AutoFilter Field:=8, _
Criteria1:=Array("=*" & Ar & "*"), Operator:=xlFilterValues
End With
End Sub

Anzeige
AW: Autofilter mit mehreren Kriterien in Zeichenabfolg
15.11.2016 17:47:24
Fennek
Hallo,
wieder ungetestet:

ActiveSheet.Range("A1:I1").AutoFilter Field:=8, _
Criteria1:=Ar, Operator:=xlFilterValues
mfg
(irgendwann wird es doch klappen?!?)
AW: Autofilter mit mehreren Kriterien in Zeichenabfolg
16.11.2016 11:19:19
Mubi
Hallo,
denke/hoffe es klappt bald :)
Wenn ich das Makro einzeln durchgehe, kommt bei der Zeile Ar = Array(Application.Transpose(Quelle.Range("A1:A180"))) der Laufzeitfehler 13 "Typen unverträglich"
bis zum Autofilter kommt es also nicht einmal
Viele Grüße
Sub Finden()
Dim Programm As Worksheet
Dim Quelle As Worksheet
Dim Ar As String
Set Quelle = Sheets("Quelle")
Set Programm = Worksheets("Auftrag")
Ar = Array(Application.Transpose(Quelle.Range("A1:A180")))
With Programm
.AutoFilterMode = False
.Range("A1:I1").AutoFilter
ActiveSheet.Range("A1:I1").AutoFilter Field:=8, _
Criteria1:=Ar, Operator:=xlFilterValues
End With
End Sub

Anzeige
AW: letzte Version (keine Lust mehr)
16.11.2016 14:14:52
Fennek
Hallo,
mit dem Autofilter kann man nur 2 Kriterien "Text enthält" übergeben, damit scheidet dieser Ansatz aus.
Es gab bisher soviele Beiträde (die ich nicht mehr lesen möchte), deshalb nur die Frage, warum der Ansatz mit Range.Find nicht präferiert wurden.
Der neue Ansatz hier filtert auch, aber auf andere und SEHR schnelle Weise:

Sub Finden()
Dim Programm As Worksheet
Dim Quelle As Worksheet
Dim Ar, Af
Set Quelle = Sheets("Quelle")
Set Programm = Worksheets("Auftrag")
lrq = Quelle.Cells(Rows.Count, "A").End(xlUp).Row
lrp = Programm.Cells(Rows.Count, "H").End(xlUp).Row
Ar = Application.Transpose(Quelle.Range("A1:A" & lrq))
Af = Application.Transpose(Programm.Range("H1:H" & lrp))
For i = 1 To lrp
Af(i) = i & ", " & Af(i)
Next i
For Each A In Ar
Az = Filter(Af, A)
For Each Z In Az
R = Val(Split(Z, ",")(0))
Cells(R, "I") = 1
Next Z
Next A
In meinem 5-Zeiler-Testfile hat es geklappt.
mfg
(direkt vor dem Abschicken habe ich noch ein paar Korrekturen vorgenommen, also teilweise ungeprüft)
Anzeige

323 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige