Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
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
Zeilen kopieren, wenn Kriterium gefunden
tco99

Hallo zusammen,
ich habe mal wieder eine Bitte.
Ich habe eine Beispieldatei, in der es ein Worksheet mit dem Namen "Quelle" gibt. Dieses Worksheet enthält die Daten. Es sind 5 Spalten. Ein zweites Worksheet heißt "Ziel". Dort sollen die Zeilen hinkopiert werden, die bestimmte Kriterien enthalten.
Ich habe ein Makro dazu im Netz gefunden, was in meiner Beispielmappe hinterlegt ist, jedoch sucht dieses Makro nur nach einem Kriterium. Ich bekomme es selber nicht angepasst. Daher habe ich die Vorarbeit gemacht, eine Auswahlmaske zu entwerfen, die ComboBoxen zu füllen und das Ausgangsmakro zu hinterlegen.
Meine Frage bzw. Bitte:
Wie muss das Makro angepasst werden, damit entweder nach einem Kriterium oder, wenn ausgewählt nach mehreren Kriterien die Zeilen von "Quelle" nach "Ziel" kopiert werden?
Eigentlich könnte man das natürlich mit dem Filter machen und dann die sichtbaren Zeilen rüberkopieren aber irgendwie kommt mir das langsamer vor, als das Kopieren von Zeilen mit dem Makro, welches ich hinterlegt habe.
Hier die Beispieldatei:
https://www.herber.de/bbs/user/68038.xls
Gruß
Erdogan
PS: Feedback ist selbstverständlich.
AW: Zeilen kopieren, wenn Kriterium gefunden
16.02.2010 13:12:36
tco99
Hallo Tino,
ich meinte es genau so!
Es funktioniert super. Ich habe den Code noch nicht ganz verstanden, werde ihn aber jetzt studieren, damit ich ihn anpassen kann, wenn es nötig wird.
Ich bedanke mich ganz herzlich bei dir!
Viele Grüße
Erdogan
AW: Zeilen kopieren, wenn Kriterium gefunden
16.02.2010 13:37:39
tco99
Hallo Tino,
ich finde die Funktion super, es macht genau das, was ich will.
Aber eine Bitte habe ich noch. Könntest du mir den Code bitte etwas näher erläutern, damit ich für die Zukunft gewappnet bin?!
Hier der OriginalCode:
Sub Start(ParamArray MeAr() As Variant)
Dim LRow As Long
Dim A As Long
For A = LBound(MeAr) To UBound(MeAr)
If MeAr(A)  "" Then
If IsNumeric(MeAr(A)) Then
MeAr(A) = "=" & Replace(MeAr(A), ",", ".")
Else
MeAr(A) = "=""" & MeAr(A) & """"
End If
Else
MeAr(A) = """"""
End If
Next A
With Tabelle2
LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("F2").FormulaR1C1 = "=AND(RC1" & MeAr(0) & ",RC2" & MeAr(1) & ",RC3" & MeAr(2) & ", _
RC4" & MeAr(3) & ")"
.Range("A1:F" & LRow).AdvancedFilter xlFilterCopy, .Range("F1:F2"), Tabelle1.Range("A1:E1")
.Range("F2").Value = ""
End With
End Sub

Vielleicht könntest du mir Kommentare dazu einfügen?! Warum ich das brauche: wenn ich mal mehr als 4 Kriterien verwenden möchte, würde ich es gerne selber anpassen können und nicht das Forum bemühen müssen. Einige wenige Kommentare könnten helfen, es muss kein Tutorium sein.
Gruß
Erdogan
Anzeige
habe Dir ein bar Kommentare reingeschrieben...
17.02.2010 07:55:58
Tino
Hallo,
'MeAr() sind die Filterdaten aus der Userform 
Sub Start(ParamArray MeAr() As Variant)
Dim LRow As Long
Dim A As Long

'Daten für Formel vorbereiten 
For A = Lbound(MeAr) To Ubound(MeAr)
 If MeAr(A) <> "" Then
  If IsNumeric(MeAr(A)) Then 'für Zahlen 
    'aus Komma einen Punkt machen 
    MeAr(A) = "=" & Replace(MeAr(A), ",", ".")
  Else 'für Text 
    MeAr(A) = "=""" & MeAr(A) & """"
  End If
 Else
    MeAr(A) = "<>""""" 'leer 
 End If
Next A

With Tabelle2
    'letzte Zeile in Spalte A 
    LRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    'Formel in Zelle F2 schreiben 
    'Bsp Formel: =UND($A2="Blau";$B2="Günther";$C2<>"";$D2<>"") 
    .Range("F2").FormulaR1C1 = "=AND(RC1" & MeAr(0) & ",RC2" & MeAr(1) & ",RC3" & MeAr(2) & ",RC4" & MeAr(3) & ")"
    'Spezialfilter über den Bereich anwenden. 
    'die Zeilen die in Spalte F True sind werden kopiert 
    .Range("A1:F" & LRow).AdvancedFilter xlFilterCopy, .Range("F1:F2"), Tabelle1.Range("A1:E1")
    'Formel wieder löschen 
    .Range("F2").Value = ""
End With


End Sub
Gruß Tino
Anzeige
AW: habe Dir ein bar Kommentare reingeschrieben...
19.02.2010 13:47:17
TCO99
Hallo Tino,
vielen Dank!
Ich war drei Tage auf einem BG-Seminar und habe erst heute meine Emails abrufen können, entschuldige bitte die späte Antwort. Ich schaue mir alles genau an und schreibe erneut, wenn etwas unklar ist.
Viele Grüße
Erdogan
AW: habe Dir ein bar Kommentare reingeschrieben...
20.02.2010 22:38:59
TCO99
Hallo Tino,
ich verwende den Code und es funktioniert gut.
Parallel habe ich noch einen etwas umständlicheren Weg ausprobiert und auch ins Forum gestellt.
Vielen Dank und Gruß
Erdogan

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige