1 Range schnell (oft) kopieren
17.10.2016 19:58:28
Michael
wie kopierte man einen Bereich am schnellsten?
Nachfolgend 3 Varianten mit Zeitangaben:
Option Explicit
Sub Makro1()
Dim t0 As Single, i&
t0 = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("C6:D1006").Clear
Range("C4:D4").Select
Selection.Copy
For i = 6 To 1006
Range("c" & i).Select
ActiveSheet.Paste
Next
Application.Calculation = xlCalculationAutomatic
Range("A1") = (Timer - t0) * 1000
' t = 1
End Sub
Sub Makro2()
Dim t0 As Single, i&, r As Range
t0 = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("C6:D1006").Clear
Set r = Range("C4:D4")
For i = 6 To 1006
r.Copy Range("c" & i)
Next
Application.Calculation = xlCalculationAutomatic
Range("A1") = (Timer - t0) * 1000
' t = ca. 3,2
End Sub
Sub Makro3()
Dim t0 As Single, i&, r As Range
t0 = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("C6:D1006").Clear
Set r = Range("C4:D4")
r.Copy
For i = 6 To 1006
Range("c" & i).PasteSpecial xlPasteAll
Next
Application.Calculation = xlCalculationAutomatic
Range("A1") = (Timer - t0) * 1000
' t = ca. 1,27
End Sub
Makro 2: r als Objekt, aber immer wieder kopiert, dauert am längsten
Makro 3: r nur einmal kopiert, aber mehrfach eingefügt: dauert immer noch länger als Makro 1.
Der Knackpunkt ist: wie füge ich "schnell" Infos aus der Zwischenablage ein?
Ich scheitere daran, daß .paste eine Methode von worksheet ist, nicht jedoch von range: hier gibt es nur .pastespecial
Das Beispiel hinkt insofern, als hier der Zielbereich zusammenhängt: DAS ginge natürlich in einem Rutsch ohne Schleife.
Tatsächlich hat der Quellbereich einige 100 Zellen, während der Zielbereich typischerweise auf ein paar 100 von ein paar 1000 Zellen in Spalte A verteilt ist: das Kriterium fürs Kopieren ist, daß die Zelle Ax nicht leer ist.
Hm, hm. Man muß die Frage nur richtig stellen, dann steckt auch schon die Antwort drin:
Sub Makro4()
Dim t0 As Single, i&, r As Range
t0 = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("C6:D1006").Clear
Range("C4:D4").Copy Range("A6:A1006").SpecialCells(xlCellTypeConstants, 23).Offset(, 2)
Application.Calculation = xlCalculationAutomatic
Range("A1") = (Timer - t0) * 1000
' t = ca. 0,05
End Sub
Was meint Ihr? Läuft das immer und zuverlässig, auch mit vielen Daten (10000 Zeilen mit ca. 800 Kopien)?
Der Test im "richtigen Leben" (von = 179, bis = ca. 5000) mit
Svon.Range("L251:HU259").Copy _
Snach.Range("A" & von).Resize(bis - von + 1).SpecialCells(xlCellTypeConstants, 23).Offset(, 11)
ist tatsächlich kaum meßbar schneller als die Schleife
While zeile Übrigens ist sichergestellt, daß sich die Zielbereiche nicht überschneiden.
(Der Quellbereich ist ziemlich übel und nicht auf meinem Mist gewachsen...)
Schöne Grüße,
Michael