Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
24.04.2024 17:19:09
Anzeige
Archiv - Navigation
1136to1140
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

Filter-Kopier-Makro erweitern

Filter-Kopier-Makro erweitern
TCO99
Hallo zusammen,
ich habe ein Makro, welches ich nicht alleine angepasst bekomme:

Public Sub ZeilenFiltern()
Dim WSQ As Worksheet
Dim WSZ As Worksheet
Set WSQ = Worksheets("Quelle") 'Anpassen, woher die Daten kommen sollen
Set WSZ = Worksheets("Ziel") 'Anpassen, wohin die Daten kopiert werden sollen
Dim i As Integer
Dim cell As Range
i = 1
For Each cell In WSQ.Range("A1:A100")
If Not cell Is Nothing Then
If cell.Value = "Meier" Then
cell.EntireRow.Copy Destination:=WSZ.Cells(i, 1)
i = i + 1
End If
End If
Next cell
End Sub

Was ich brauche ist, dass nicht nur in der Spalte A nach einem bestimmten Begriff (Meier) gesucht wird, sondern auch in der Spalte B nach dem Begriff "Kunde" und z.B. in der Spalte X nach dem Begriff " bezahlt".
Oder mit anderen Worten: wie kann ich das Makro anpassen, damit ich zu zu kopierenden Daten besser filtern, dass heißt auf mehr als eine Spalte untersuchen kann?
Ich habe zwar einige Versuche gemacht, jedoch gelang es nicht. Z.B. habe ich es so versucht:
Dim i As Integer
Dim cell As Range
Dim cell2 As Range
i = 1
For Each cell In WSQ.Range("A1:A100") And For Each cell2 In WSQ.Range("B1:B100")
If Not cell Is Nothing Then
If cell.Value = "Meier" And Cell2.Value = "Kunde" Then
cell.EntireRow.Copy Destination:=WSZ.Cells(i, 1)
i = i + 1
End If
End If
Next cell
Gruß
Erdogan
PS: Feedback ist selbstverständlich.

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

Betreff
Benutzer
Anzeige
AW: Filter-Kopier-Makro erweitern
19.02.2010 18:00:17
fcs
Hallo Erdogan,
die For-Next-Schleifen kann man nicht so aufbauen. Alle Prüfungen muss du in If-Zeile(n) einbauen. Die zusätzlich zu prüfenden Spalten legst du als Offset relativ zu Cell fest.
Wesentlich flexibler wird das Ganze, wenn du in der Quelltabelle mit dem Autofilter arbeitest und immer die noch sichtbaren Zeilen ins Zielblatt kopierst.
Gruß
Franz
Public Sub ZeilenFiltern()
Dim WSQ As Worksheet
Dim WSZ As Worksheet
Set WSQ = Worksheets("Quelle") 'Anpassen, woher die Daten kommen sollen
Set WSZ = Worksheets("Ziel") 'Anpassen, wohin die Daten kopiert werden sollen
Dim i As Integer
Dim cell As Range
i = 1
For Each cell In WSQ.Range("A1:A100")
'If Not cell Is Nothing Then 'überflüssig
If cell.Value = "Meier" _
And cell.Offset(0, 1).Value = "Kunde" _
And cell.Offset(0, 23).Value = "bezahlt" Then
cell.EntireRow.Copy Destination:=WSZ.Cells(i, 1)
i = i + 1
End If
'End If 'überflüssig
Next cell
End Sub
'wesentlich flexibler in Verbindung mit Autofilter
Public Sub ZeilenFiltern1()
'in Verbindung mit Autofilter in der Quelltabelle
Dim WSQ As Worksheet
Dim WSZ As Worksheet
Set WSQ = Worksheets("Quelle") 'Anpassen, woher die Daten kommen sollen
Set WSZ = Worksheets("Ziel") 'Anpassen, wohin die Daten kopiert werden sollen
Dim i As Integer
Dim cell As Range
i = 1
For Each cell In WSQ.Range("A2:A100")
If cell.EntireRow.Hidden = False Then
cell.EntireRow.Copy Destination:=WSZ.Cells(i, 1)
i = i + 1
End If
Next cell
End Sub

Anzeige
AW: Filter-Kopier-Makro erweitern
19.02.2010 23:05:34
TCO99
Hallo Franz,
vielen Dank für deine Antwort!
Da habe ich ja gleich zwei Optionen :-)
Ich versuche beide und gebe dann noch Feedback.
Wenn mir nicht die Augen zufallen, versuche ich mich noch heute Nacht daran.
Viele Grüße
Erdogan
AW: Filter-Kopier-Makro erweitern
20.02.2010 09:33:58
Hajo_Zi
Hallo Erdogan,
warum ist die Frage offen? Ich habe nichts im Beitrag gelesen das jemand vorbei kommen soll und Dich bei der Testung untestützen soll. Wo sich dann auch gleich die Frage stellt der Bezahlung.

AW: Filter-Kopier-Makro erweitern
20.02.2010 22:32:05
TCO99
Hallo Hajo,
weil ich noch ein Feedback geben wollte.
Gruß
Erdogan
An Alle
--------
Aufgrund des Rats von Franz habe ich die Lösung mit dem Autofilter gewählt.
Für Alle, die eine ähnliche Frage haben, hier die angepasste Lösung:
Sub Filtern()
Application.ScreenUpdating = False
Dim WS1 As Worksheet, WS2 As Worksheet
Set WS1 = Worksheets("Quelle")
Set WS2 = Worksheets("Ziel")
'Ergebnisseite vorbereiten
WS2.Cells.ClearContents
'Autofilter setzen
WS1.Range("A1").AutoFilter
'Nach Kriterium1 filtern
If Filtermaske.ComboBox1.Text = "" Then
Else
WS1.Range("A1").AutoFilter _
Field:=1, _
Criteria1:=Filtermaske.ComboBox1.Text
End If
'Nach Kriterium2 filtern
If Filtermaske.ComboBox2.Text = "" Then
Else
WS1.Range("A1").AutoFilter _
Field:=2, _
Criteria1:=Filtermaske.ComboBox2.Text
End If
'Nach Kriterium3 filtern
If Filtermaske.ComboBox3.Text = "" Then
Else
WS1.Range("A1").AutoFilter _
Field:=3, _
Criteria1:=Filtermaske.ComboBox3.Text
End If
'Nach Kriterium4 filtern
If Filtermaske.ComboBox4.Text = "" Then
Else
WS1.Range("A1").AutoFilter _
Field:=5, _
Criteria1:=Filtermaske.ComboBox4.Text
End If
'Nach Kriterium5 filtern
If Filtermaske.ComboBox5.Text = "" Then
Else
WS1.Range("A1").AutoFilter _
Field:=6, _
Criteria1:=Filtermaske.ComboBox5.Text
End If
'Nach Kriterium6 filtern
If Filtermaske.ComboBox6.Text = "" Then
Else
WS1.Range("A1").AutoFilter _
Field:=14, _
Criteria1:=Filtermaske.ComboBox6.Text
End If
'Gefilterte Daten übernehmen
WS1.Range("A:N").Copy
WS1.Range("A:N").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Autofilter abgeschalten
WS1.Range("A1").AutoFilter
'Unerwünschte Spalten löschen
WS2.Range("I:M").Delete Shift:=xlToLeft
'Spalten mit Datumsformat versehen
WS2.Columns("F:H").NumberFormat = "dd/mm/yyyy"
'Spaltenbreiten anpassen
WS2.Range("A:I").EntireColumn.AutoFit
'Ergebnisse zeigen
Filtermaske.ListBox1.RowSource = "Ziel!A2:I20000"
Set WS1 = Nothing
Set WS2 = Nothing
Application.ScreenUpdating = True
End Sub
Dank an Alle, die geholfen haben!
Gruß
Erdogan
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige