Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1708to1712
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

bestimmte Inhalte suchen und in Reihenfolge senden

bestimmte Inhalte suchen und in Reihenfolge senden
25.08.2019 10:44:48
Jun
Hallo zusammen,
kann jemand mir helfen, folgendes Problem in der "Beispiel"-Datei zu lösen?
https://www.herber.de/bbs/user/131604.xlsm
Arbeitsblatt "Info":
In Spalte A gibt es viele unterschiedliche und auch beliebige Code/Texte. Diese Code/Texte sollten per VBA geprüft werden, ob es "P1", "P2", "P3", "P4" oder / und "P6" beinhalten, dann ins Arbeitsblatt "Datenbank" Spalte "AA", ab Zeile 13 ausfüllen.
Wenn keine von den fünf Code/Texte gefunden werden, werden auch keine Code in Spalte "AA" im "Datenbank" ausgefüllt.
Wenn alle von den fünf Code/Texte gefunden werden, werden alle Code in Spalte "AA" im "Datenbank" ausgefüllt und in folgender Reihenfolge: "P1" in Zelle "AA13", "P2" in Zelle "AA14", "P3" in Zelle "AA15", "P4" in Zelle "AA16", "P6" in Zelle "AA17".
Wenn es nur Teil von denen gefunden wird, z.B. nur "P1" und "P3", dann wird "P1" in Zelle "AA13" und "P3" in "AA14" ausgefüllt. Oder z.B. nur "P2", "P3" und "P6", dann wird "P2" in Zelle "AA13" und "P3" in "AA14" und "P6" in Zelle "AA15" ausgefüllt.
Vielen Dank!
LG
Jun

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: bestimmte Inhalte suchen und in Reihenfolge senden
25.08.2019 11:43:00
Werner
Hallo,
so:
Sub Makro1()
Application.ScreenUpdating = False
With Worksheets("Info")
.Range("$A$1:$A$" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:= _
"=P*"
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Copy
With Worksheets("Datenbank")
.Range("AA13").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.Range("AA13:AA" & .Cells(.Rows.Count, "AA").End(xlUp).Row).Sort , Key1:=.Range(" _
AA13"), _
Order1:=xlAscending, Header:=xlNo
End With
End With
.AutoFilterMode = False
End With
End Sub
Gruß Werner
Anzeige
nochmal
25.08.2019 11:44:46
Werner
Hallo,
..der gleiche Code. Habe die Zeilenumbrüche, die von der Forensoftware eingefügt wurden, entfernt.
Sub Makro1()
Application.ScreenUpdating = False
With Worksheets("Info")
.Range("$A$1:$A$" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, _
Criteria1:="=P*"
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Copy
With Worksheets("Datenbank")
.Range("AA13").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.Range("AA13:AA" & .Cells(.Rows.Count, "AA").End(xlUp).Row).Sort , _
Key1:=.Range("AA13"), Order1:=xlAscending, Header:=xlNo
End With
End With
.AutoFilterMode = False
End With
End Sub
Gruß Werner
Anzeige
AW: nochmal
25.08.2019 19:43:41
Jun
Hallo Werner,
vielen Dank für die schnelle Hilfe. Ich habe nicht klar genug erklärt. Also es wird auch andere Code mit P anfangen, z.B. Px, P8, PW usw. Eine Frage zu den Code ......Criteria1:="=P*". Wenn man mit "*" schreibt, kann es sein, dass die andere P-Code auch auskommen oder wird die VBA-Code trotzdem funktionieren? Danke!
LG
Jun
AW: nochmal
25.08.2019 22:10:01
Jun
Hallo Werner,
ich habe gerade deine Code probiert, das funktioniert sehr gut außer das Problem ich erwähnt habe. Also in der echte Excel-Datei, die Code ist 4-stellig. Deshalb kommt manchmal solches Problem, z.B. P320, P321, P322, P327, P329, P221 usw. Davon brauche ich nur die Fett Nummer "P321" und "P322". Ich habe versucht, die Code "= P82*" anstatt "= P*" schreiben, aber die Nummer "P320" wird auch kommen, die ich nicht brauche. Hast du eine Idee, wie man das Problem auslöst? Vielen DANK!
Gruß
Jun
Anzeige
AW: nochmal
26.08.2019 10:04:41
Werner
Hallo,
eine Lösung hätte ich vielleicht schon.
Aber ob ich Lust dazu haben die dir auch zu posten?
Du hast es ja nicht für nötig befunden, trotz des Hinweises von Steve, die Beiträge in den verschiedenen Foren untereinander zu verlinken.
Zudem eröffnest du im anderen Forum einen neuen Beitrag mit der gleichen Problembeschreibung wie hier in deinem Eröffnungsbeitrag. Und diese Problembeschreibung ist ja ganz offensichtlich falsch, wie aus deinem letzten Beitrag hier hervor geht. Da hat dann Karin im anderen Forum auch für den Papierkorb gearbeitet, weil du es nicht für nötig gehalten hast dein Problem richtig zu schildern.
Da kommt sicher Freude auf.
Gruß Werner
Anzeige
AW: nochmal
26.08.2019 12:55:06
Jun
Hallo Werner,
es tut mir leid, dass ich in beide Foren postet, denn ich nicht die Lösung dringend brauche und habe gedacht, so sieht mehrere Leute. Ich habe nicht gewusst, dass man das Crossposting nicht machen sollte. Es wird in Zukunft nicht passieren.
Gruß
Jun
AW: nochmal
27.08.2019 14:55:54
Werner
Hallo,
so wie ich das sehe, suchst du eine Möglichkeit nach mehreren Werten zu filtern und das Filterergebnis dann zu kopieren.
Sub Makro1()
Dim loLetzte As Long, i As Long, Filter As Variant
Application.ScreenUpdating = False
With Worksheets("Info")
If .Range("D1")  "" Then
loLetzte = .Cells(.Rows.Count, "D").End(xlUp).Row
For i = 1 To loLetzte
If WorksheetFunction.CountIf(.Columns(1), .Cells(i, "D")) > 0 Then
Exit For
Else
Exit Sub
End If
Next i
Filter = WorksheetFunction.Transpose(.Range(.Cells(1, "D"), _
.Cells(loLetzte, "D")).Value)
.Range("$A$1:$A$" & .Cells(.Rows.Count, "A").End(xlUp).Row).AutoFilter _
Field:=1, Criteria1:=Filter, Operator:=xlFilterValues
With .AutoFilter.Range
.Offset(1).Resize(.Rows.Count - 1).Copy
With Worksheets("Datenbank")
.Range("AA13").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
.Range("AA13:AA" & .Cells(.Rows.Count, "AA").End(xlUp).Row).Sort , _
key1:=.Range("AA13"), Order1:=xlAscending, Header:=xlNo
End With
End With
.Range(.Cells(1, "D"), .Cells(loLetzte, "D")).ClearContents
.AutoFilterMode = False
Else
MsgBox "Es gibt keine Filterkriterien."
End If
End With
End Sub
Im Blatt "Info" in Spalte D, ab D1, gibst du untereinander deine "Suchbegriffe" ein. Das Makro filtert dann die Spalte A nach den Suchbegriffen in Spalte D und kopiert das Filterergebnis ins Blatt "Datenbank". Die Liste mit den Suchbegriffen in Spalte D wird dann wieder gelöscht.
Gruß Werner
Anzeige
Crossposting
26.08.2019 09:29:39
SF
https://www.ms-office-forum.net/forum/showthread.php?t=362022
Gruß,
steve1da
AW: Crossposting
26.08.2019 12:59:44
Jun
Hallo Steve,
Danke für die Info. Jetzt weiß ich den Bescheid und mache ich das nicht mehr. Sorry.
Gruß
Jun

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige