Macro zum kopieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

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

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Macro zum kopieren

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread