Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1420to1424
1420to1424
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Macro zum kopieren

Forumthread: Macro zum kopieren

Macro zum kopieren
12.04.2015 15:02:44
Thomas
Hallo,
ich habe im Tabellenblatt 1 Spalten d-z Daten zustehen. In Spalte D stehen die Datumswerte. Im Tabellenblatt 2 möchte ich gern in der Zelle das A1 Anfangsdatum und in Zelle A2 das Enddatum eintragen. Nun suche ich ein Marco welches ich per Button starten kann. Dieses Macro soll dann die gefüllten Zeilen aus Tabellenblatt 1 die innerhalb des Zeitbereichs liegen sortiert ins Tabellenblatt 2 kopieren. Ich weiss das man dies mit Spezialfilter oder mit Pivat machen könnte. Aber ich benötige dies für sehr viele Exceltabellen, sortiert und ohne ausgeblendeten Zeilen. Ich denke das ich das macro dann selbst anpassen könnte ( Zeilen oder bestimmte Spalten.
Tabelle 1
Spalte d bis Z
Tabelle 2
A1 Anfangsdatum
A2 Enddatum
ab A4 von den betroffenen Zeilen die Spalten d,F,G,y aus Tabellenblatt 1 .
Kann jemand helfen?
Liebe grüsse Thomas

Anzeige

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Macro zum kopieren
12.04.2015 15:39:03
Thomas
Hallo,
so etwas würde auch gehen nur leider bekomme ich es nicht um laufen.
Hier "Copy Sheets("Tabelle2")" ist irgentwie ein Fehler drin. Und das Macro bricht ab wenn es auf ein Text in spalte A stößt. Wäre aber besser wenn diese Zeile dann ignoriert wird und das Macro mit den Rest weitermacht.
besten dank schon mal im voraus.
Liebe grüsse Thomas
Sub Kopieren()
Dim rngLast As Range
Dim rngFirst As Range
Dim start As Date
Dim ende As Date
start = Application.InputBox("Format: TT.MM.JJ", "Startdatum eingeben", Type:=1)
ende = Application.InputBox("Format: TT.MM.JJ", "Enddatum eingeben", Type:=1)
Set rngLast = Range("A:A").Find(what:=ende, after:=Range("A1"), searchdirection:=xlPrevious)
Set rngFirst = Range("A:A").Find(what:=start, after:=rngLast, searchdirection:=xlNext)
Cells(rngFirst.Row, 2).Resize(rngLast.Row - rngFirst.Row + 1, 6).Copy Sheets("Tabelle2")
Set rngLast = Nothing
Set rngFirst = Nothing
End Sub

Anzeige
AW: Macro zum kopieren
13.04.2015 01:26:00
Michael
Hallo Thomas,
die ganze Geschichte ist nicht so trivial, wie Du Dir vielleicht vorstellst: was ist, wenn das gesuchte Datum gar nicht vorhanden ist? Das gehört sich im Makro abgefangen, damit es nicht mit Fehler stehenbleibt, ist aber auch logisch zu berücksichtigen.
Sind die folgenden Voraussetzungen richtig? Nämlich, daß
- die Daten bereits nach Datum sortiert sind
- alle "Datensätze" (also Zeilen) die gleiche Struktur haben?
Dein Kommentar "bricht ab wenn Text in A" deutet darauf hin, daß die zweite Voraussetzung nicht erfüllt ist. Und: In Deinem ersten Post steht, daß die zu suchenden Datümer in Spalte D stehen, also solltest Du sie auch da suchen (und nicht in Spalte A).
Wie viele Zeilen sind es denn jeweils?
Bei jeweils ein paar hundert (und insbesondere bei unsortierten Daten) würde ich einen "blöden" Algorithmus nehmen, der in jeder Zeile das Datum vergleicht und nur die "guten" kopiert - langsam, wenig elegant, aber sicher funktionell.
Eine Beispieldatei wäre aber nützlich.
Schöne Grüße,
Michael

Anzeige
AW: Macro zum kopieren
13.04.2015 05:18:38
Thomas
Hallo Michael,
erstmal besten Dank das Du dich damit beschäftigst.
ja mit den Spalten habe ich mich verschrieben. Ich habe eine Beispieledatei erstellt. Die Datumsreihe ist nicht sortiert sondern quer durcheinander Und es können auch Textdaten dazwischen sein. Ich denke es könnten an die 2000 Daten werden.
https://www.herber.de/bbs/user/97041.xlsx
Liebe Grüsse Thomas

Anzeige
AW: Macro zum kopieren
13.04.2015 09:51:41
fcs
Hallo Thomas,
hier ein entsprechendes Makro als Start.
Gruß
Franz 
Public Sub prcCopyDatumsbereich()
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim Zeile_Z1 As Long, Zeile_Z As Long, Zeile_Q As Long, StatusCalc As Long
Dim rngCopy As Range
Dim varStart As Variant, varEnde As Variant, SpalteDatum As Long
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set wksZiel = ActiveWorkbook.Worksheets(2) '2 ggf. durch Blattname in Anführungszeichen  _
ersetzen
SpalteDatum = 4  'Spate D
With wksZiel
varStart = .Range("A1")
varEnde = .Range("A2")
Zeile_Z1 = Application.WorksheetFunction.Max(3, _
.Cells(.Rows.Count, SpalteDatum).End(xlUp).Row) + 1
Zeile_Z = Zeile_Z1 - 1
End With
Set wksQuelle = ActiveWorkbook.Worksheets(1) '1 ggf. durch Blattname in Anführungszeichen  _
ersetzen
With wksQuelle
For Zeile_Q = 1 To .Cells(.Rows.Count, SpalteDatum).End(xlUp).Row
If IsDate(.Cells(Zeile_Q, SpalteDatum)) Then
If .Cells(Zeile_Q, SpalteDatum) >= varStart _
And .Cells(Zeile_Q, SpalteDatum)  Zeile_Z1 Then
With wksZiel
.Range(.Rows(Zeile_Z1), .Rows(Zeile_Z)).Sort _
Key1:=.Cells(Zeile_Z1, SpalteDatum), order1:=xlAscending, Header:=xlNo
End With
End If
With Application
.ScreenUpdating = False
.Calculation = StatusCalc
End With
End Sub

Anzeige
Genau so
13.04.2015 15:13:15
Michael
Guten "morgen" zusammen,
genau so einen Algo hatte ich mir vorgestellt.
@ Franz: ich ziehe das "blöd" aus meinem vorherigen Post hochoffiziell zurück.
Happy Exceling,
Michael

AW: Genau so
13.04.2015 17:05:59
fcs
Hallo Michael,
für mich gibt es folgende Kategorien von Makros:
1. Funktioniert nicht
2. Funktioniert - mit den Unterkategorien
- langsam
- schnell
- schnell - elegant programmiert
Meine vorgeschlagenen Lösung ist akzeptabel wenn der Anteil der zu kopierenden Zeilen nicht zu hoch ist und die max. Anzahl Datenzeilen bei wenigen 1000 liegt. Sie fällt mehr in die Kategorie quick&dirty bzw. brute force.
Andere Strategien wären dann:
- Arbeiten über Datenarrays, wobei diese meist auch brute force sind, aber eben saumäßig schnell.
- Sortieren der Originalliste nach Datum und kopieren der Ergebnisdaten in einem Block
Gruß
Franz

Anzeige
AW: Genau so
13.04.2015 17:46:37
Michael
Hallo Franz,
ich bin völlig Deiner Meinung!
In der Praxis bin ich noch nicht an die Grenzen von X gestoßen, etwaige Wartezeiten von bis zu ein paar Sekunden finde ich völlig akzeptabel (in dem Fall werden es eher nur ms sein), weil das immer noch in keinem Vergleich steht zu der Zeit, die die reine Bedienung erfordert.
Aber sag, wie ist das mit den Excel-internen Datenstrukturen konkret? Um ein Array zu verwenden, mußt Du die Daten erst mal da reinkopieren, das kostet Zeit, und mir ist unklar, inwiefern ein Zugriff auf ein Array schneller ist als in eine Tabelle: die ist letztlich doch auch nur ein Array?
Mit allen Eigenschaften natürlich. Hm, hm, ein reines Datenarray schleppt natürlich nicht so viel Zeug mit rum... Hm, hm, liegt es letztlich am CPU-Cache? Das Array "liegt in einem Stück an", gleiche Felder der Zellen vermutlich nicht...
Excel sortiert natürlich auch rasend schnell (ich habe keine richtig großen Daten, die größte Tabelle hat so 5000 Datensätze, das geht ohne spürbar vergangene Zeit) und ist erst im Vergleich mit Libre wirklich zu schätzen: das gleiche Makro benötigt dort schlappe 5-10 Sekunden.
Was darauf schließen ließe, daß Excel intern auch zunächst ein Array sortiert und dann erst die Werte in die Tabelle zurückschreibt.
Schöne Grüße,
Michael

Anzeige
AW: Genau so
14.04.2015 08:31:01
Thomas
Hallo,
erstmal besten Dank für eure Bemühungen. Das Makro ist super ich habe es mal mit 4000 Datensätzen getestet es funktioniert bestens. Nur zwei Verbesserungen könnte ich noch gebrauchen. Wär super wenn die alten Datensätze in Tabelle 2 gelöscht werden und dann erst die neuen reinkopiert werden. Und ich könnte noch eine Stellschraube gebrauchen so das ich nicht immer alle Spalten des jeweiligen Datensatzes mit kopiere. Hier bräuchte ich nur eine Markierung im Code wo ich es dann jeweils anpassen könnte. Sagen wir z.B. nur die Spalten D,F bis H. Da ich dieses Macro für verschiedene Anwendungen benutzen möchte wäre das Klasse.
Liebe grüsse Thomas

Anzeige
AW: Genau so
14.04.2015 12:36:46
fcs
Hallo Thomas,
ich hab das Makro jetzt so erweitert, dass alte Daten aus vorheriger Suche ggf. gelöscht werden und die Möglichkeit besteht nur bestimmte Zellen zu kopieren.
Für Variationen der Spalten muss du nur die 2. Case-Zeile anpassen.
Gruß
Franz
Private Sub prcCopyDatumsbereich()
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim Zeile_Z1 As Long, Zeile_Z As Long, Zeile_Q As Long, StatusCalc As Long
Dim rngCopy As Range
Dim varStart As Variant, varEnde As Variant, SpalteDatum As Long
Dim Spalte_Q As Long, Spalte_Z As Long, SpalteDatum_Z As Long
With Application
.ScreenUpdating = False
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set wksZiel = ActiveWorkbook.Worksheets(2) '2 ggf. durch Blattname in _
Anführungszeichen ersetzen
SpalteDatum = 4  'Spalte D - Spalte mit Datum in Quelltabelle
SpalteDatum_Z = SpalteDatum  'Spalte mit Datum in Zieltabelle. Die beiden _
Spalten müssen identisch sein, wenn ganze Zeilen kopiert werden!!!
With wksZiel
varStart = .Range("A1")
varEnde = .Range("A2")
Zeile_Z1 = 4 '1. Einfügezeile für kopierte Daten
'letzte Zeile mit Daten in Datumsspalte
Zeile_Z = .Cells(.Rows.Count, SpalteDatum_Z).End(xlUp).Row
If Zeile_Z >= Zeile_Z1 Then
'Altdaten löschen
.Range(.Rows(Zeile_Z1), .Rows(Zeile_Z)).ClearContents
End If
Zeile_Z = Zeile_Z1 - 1 'Startzähler setzen
End With
Set wksQuelle = ActiveWorkbook.Worksheets(1) '1 ggf. durch Blattname in _
Anführungszeichen ersetzen
With wksQuelle
For Zeile_Q = 1 To .Cells(.Rows.Count, SpalteDatum).End(xlUp).Row
If IsDate(.Cells(Zeile_Q, SpalteDatum)) Then
'Prüfkriterien
If .Cells(Zeile_Q, SpalteDatum) >= varStart _
And .Cells(Zeile_Q, SpalteDatum)  Zeile_Z1 Then
With wksZiel
.Range(.Rows(Zeile_Z1), .Rows(Zeile_Z)).Sort _
Key1:=.Cells(Zeile_Z1, SpalteDatum_Z), order1:=xlAscending, Header:=xlNo
End With
End If
With Application
.ScreenUpdating = False
.Calculation = StatusCalc
End With
End Sub

Anzeige
AW: Daten-Arrays - Makrogeschwindigkeit
14.04.2015 08:39:23
fcs
Hallo Michael,
wenn man es in der Quelle nur mit Zellen ohne Formeln zu tun hat oder im Ziel nur Werte eingefügt werden sollen, dann ist der Weg über Datenarrays ab ca. 2000 bis 5000 Zeilen sehr schnell der effektivste. Insbesondere dann, wenn man mehrere Kriterien vergleichen möchte, die man nicht via Autofilter abdecken kann.
Wie du schon angemerkt hast: Im Array sind die Daten komplett losgelöst von der Exceltabelle im Arbeitsspeicher (hoffentlich nicht in einem auf die Festpaltte ausgelagerten Teil). Somit sind im Makroablauf keine Zugriffe auf einzelne Zellen der Tabelle mehr erforderlich und dadurch wird die Ausführungsgeschwindigkeit so extrem beschleinigt. Da schrumpfen Sekunden tatsächlich zu Millisekunden.
Der 1. wesentliche Schritt zur Beschleunigng istaber immer Excel von unnötigen Arbeiten während der Makroausführung zu befreien:
- Deaktivieren der Bildschirmaktualisierung
- Berechnungsmodus auf manuell - neu berechnen nur bei Bedarf
- ggf. Deaktivieren der Ereignismakros um rekursive wiederholte Makroausführung oder sogar Endlosschleifen zu vermeiden.
Gruß
Franz

Anzeige
AW: Daten-Arrays - Makrogeschwindigkeit
14.04.2015 19:14:17
Michael
Hallo Franz,
es hat mir keine Ruhe gelassen, denn prinzipiell sollte man meinen, daß komplette Excel-Tabellen eben auch komplett im RAM sind (bei X GB heutzutage).
Ich hab mal das Objektmodell angekratzt und in eine Tabelle mit links gesteckt: https://www.herber.de/bbs/user/97077.xls
Es ergeben sich rund 150 Eigenschaften pro Zelle, die X irgendwie "mitschleppen" muß, wenn man direkt mit Zellen arbeitet.
Nun gut, ist alles ein bissel akademisch, denn Thomas ist ja auch bei 4000 Zeilen mit der Geschwindigkeit zufrieden, aber es ist gut, die Dinge mal einigermaßen durchdacht und im Hinterkopf zu haben.
Vielen Dank für die Anregungen und happy exceling,
Michael

Anzeige
AW: Daten-Arrays - Makrogeschwindigkeit
15.04.2015 08:16:43
Thomas
Hallo,
vielen Dank ich sehe im Makro die stellschrauben und funktioniert super. Im weitern nachdenken ist mir noch aufgefallen das es
nicht schlecht sein würde wenn man die Überschriften der jeweiligen Spalten och irgendwie mit kopieren
könnte. Ist das Möglich?
vielen vielen Dank
Liebe Grüsse Thomas

Anzeige
AW: Kopieren mit Kriterien
15.04.2015 10:25:06
fcs
Hallo Thomas,
damit die Spaltentitel aus Zeile 1 mit kopiert werden müssen die Prüfkriterien in der Kopier-Schleife und die Sortierung in der Zieltabelle angepasst werden.
    If IsDate(.Cells(Zeile_Q, SpalteDatum)) Or Zeile_Q = 1 Then
'Prüfkriterien
If (.Cells(Zeile_Q, SpalteDatum) >= varStart _
And .Cells(Zeile_Q, SpalteDatum)

Sortieren Zieltabelle: 
  If Zeile_Z > Zeile_Z1 + 1 Then
With wksZiel
.Range(.Rows(Zeile_Z1), .Rows(Zeile_Z)).Sort _
Key1:=.Cells(Zeile_Z1, SpalteDatum_Z), order1:=xlAscending, Header:=xlYes
End With
End If
Gruß
Franz

Anzeige
Besten Dank an Franz
15.04.2015 23:10:50
Thomas
Hallo Franz,
konnte es noch testen es funktioniert super.
Ich bedanke mich bei Dir das macro wird mir viel arbeit abnehmen.
Liebe Früsse Thomas
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige