Stringsuche mit mehreren Vorgaben

[Eizi100]

Hallo an euch Profis

Ich suche noch immer nach eine Lösung für mein Problem
Mit unterem Code kopiere ich die Zeile, wo in der Spalte C eine "4" steht. Ich müsste den aber so umbauen, dass die Zeile kopiert wird wenn eine "3" und/ oder "4" steht.

Ich hätte das mit einem 2.Code gelöst. Das Problem ist, dass dann zuerst die Zeilen mit "4" und dann "3" kopiert. Da passt die Reihung natürlich nicht mehr

Code:

Sub BedingteZeilenKopieren()
Dim Zeile As Long
Dim ZeileMax As Long
Dim n As Long
Dim Suche As String
Dim Zielblatt As Worksheet, Quellblatt As Worksheet
Set Quellblatt = Worksheets("e466abwb")  'Quelle anpassen
Set Zielblatt = Worksheets("Tabelle1") 'Zielsheet als vorhandenens Sheet setzen
'Set Zielblatt = Worksheets.Add          'neues Sheet anlegen
Suche = "4"  'Suchbegriff

With Quellblatt

  ZeileMax = .UsedRange.Rows.Count  'letzte Zeile im Quellsheet
  n = 2                              'erste Zeile im ZielSheet
  For Zeile = 2 To ZeileMax          'Quellsheet zeilenweise durchlaufen
    If Left(.Cells(Zeile, 3).Value, Len(Suche)) = Suche Then    'prüfe Suchbegriff in Spalte c
        .Rows(Zeile).Copy Destination:=Zielblatt.Rows(n)  'Zeile kopieren in Zeile n
        n = n + 1                    'Nächste Zeile im Zielsheet setzen
    End If
  Next Zeile

End With

End Sub

Danke für eure Hilfe
LG
Michael

[{Boris}]

Hi,

ungetestet:

Dim Suche As String, Suche2 As String
Dim Zielblatt As Worksheet, Quellblatt As Worksheet
Set Quellblatt = Worksheets("e466abwb")  'Quelle anpassen
Set Zielblatt = Worksheets("Tabelle1") 'Zielsheet als vorhandenens Sheet setzen
'Set Zielblatt = Worksheets.Add          'neues Sheet anlegen
Suche = "4"  'Suchbegriff
Suche2 = "3"

With Quellblatt

  ZeileMax = .UsedRange.Rows.Count  'letzte Zeile im Quellsheet
  n = 2                              'erste Zeile im ZielSheet
  For Zeile = 2 To ZeileMax          'Quellsheet zeilenweise durchlaufen
    If Left(.Cells(Zeile, 3).Value, Len(Suche)) = Suche Or Left(.Cells(Zeile, 3).Value, Len(Suche)) = Suche2 Then

[Eizi100]

Ich glaube ich spinne

Ist das wirklich so einfach für dich??? Und das ungetestet?? das klappt. Ich hab 2 Tage gegoogelt. D A N K E

Ein Frage hätte ich noch (nur wenns nicht umständlich ist)
Wenn ich nicht die Ganze Zeile sondern nur "B" und "C" kopieren will
Was müsste ich da ändern

.Rows(Zeile).Copy Destination:=Zielblatt.Rows(n)  'Zeile kopieren in Zeile n


LG
Michael

[Kuwer]

Hallo,

z.B. so:

Code:

Sub BedingteZeilenKopieren()
  Dim Zeile As Long
  Dim ZeileMax As Long
  Dim i As Long, n As Long
  Dim Suche As Variant
  Dim Zielblatt As Worksheet, Quellblatt As Worksheet
  Set Quellblatt = Worksheets("e466abwb")  'Quelle anpassen
  Set Zielblatt = Worksheets("Tabelle1") 'Zielsheet als vorhandenens Sheet setzen
  Set Zielblatt = Worksheets.Add          'neues Sheet anlegen
  Suche = Array("3", "4") 'Suchbegriffe
  
  With Quellblatt
    ZeileMax = .UsedRange.Rows.Count  'letzte Zeile im Quellsheet
    n = 2                              'erste Zeile im ZielSheet
    For Zeile = 2 To ZeileMax          'Quellsheet zeilenweise durchlaufen
      For i = LBound(Suche) To UBound(Suche)
        If Left(.Cells(Zeile, 3).Value, Len(Suche(i))) = Suche(i) Then     'prüfe Suchbegriff in Spalte c
          .Rows(Zeile).Copy Destination:=Zielblatt.Rows(n)  'Zeile kopieren in Zeile n
          n = n + 1                    'Nächste Zeile im Zielsheet setzen
          Exit For
        End If
      Next i
    Next Zeile
  End With
End Sub

Gruß Uwe

[Eizi100]

So Danke

Ihr seid echt der Wahnsinn


LG
Michael

[{Boris}]

Hi,

ebenfalls ungetestet:

.Range("B" & Zeile, "C" & Zeile).Copy Destination:=Zielblatt.Range("B" & n)

Damit wird im Zielblatt auch ab Spalte B eingefügt. Willst Du dort eine andere erste Spalte haben, musst Du dieses B entsprechend anpassen.

[Kuwer]

Hallo Michael,

Wenn ich nicht die Ganze Zeile sondern nur "B" und "C" kopieren will
Was müsste ich da ändern

.Rows(Zeile).Copy Destination:=Zielblatt.Rows(n)  'Zeile kopieren in Zeile n

.Cells(Zeile, 2).Resize(, 2).Copy Destination:=Zielblatt.Cells(n, 1)

Gruß Uwe

[Eizi100]

Jetzt kann ich beruhigt in den Nachtdienst fahren
perfetto

Danke nochmals

LG
Michael