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

Code langsam, geht das schneller?

Forumthread: Code langsam, geht das schneller?

Code langsam, geht das schneller?
Dietmar
Guten Morgen in die Runde,
kann mir jemand sagen, ob und wie nachfolgendes Makro verbessert werden kann?
Meine letzte Maßnahme war vor der Ausführung die Berechnung auf manuell zu setzen; dennoch läuft das Makro noch recht langsam.
Danke vorab und allen noch einen schönen Sonntag
Viele Grüße
Dietmar aus Aachen
Sub DerNächsteBitte1()
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="123"
Application.Calculation = xlCalculationManual
On Error GoTo Fehler
Range("M14:O129").Copy
Range("P14:R129").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P14:R129").Copy
Range("J14:L129").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("P14:R129").ClearContents
Range("AH14:AJ129").Copy
Range("AK14:AM129").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AK14:AM129").Copy
Range("AE14:AG129").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AK14:AM129").ClearContents
Range("BC14:BE129").Copy
Range("BF14:BH129").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("BF14:BH129").Copy
Range("AZ14:BB129").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("BF14:BH129").ClearContents
Range("G14:G129").ClearContents
Range("AB14:AB58").ClearContents
Range("AB61:AB129").ClearContents
Range("AW14:AW129").ClearContents
Range("AW9:AX10").ClearContents
Range("AZ1").FormulaR1C1 = "FALSE"    'neu seit 28.07.2009 wg. EC-Zahlungskontrollfeld
Range("F18").Select
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="123"
ActiveSheet.EnableSelection = xlUnlockedCells
Application.Calculation = xlCalculationAutomatic
Exit Sub
Fehler:
MsgBox "Fehler, bitte mit Administrator in Verbindung setzen", vbCritical, "Fehlermeldung"
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="123"
ActiveSheet.EnableSelection = xlUnlockedCells 'neu seit 14.6.2008, nicht bei Zahlenmeldung, da  _
diese kopierbar sein muss
Application.Calculation = xlCalculationAutomatic
End Sub

Anzeige
AW: Code langsam, geht das schneller?
05.09.2010 10:37:38
Gerd
Hallo Dietmar,
hat es einen bestimmten Grund, zuerst A nach B zu kopieren, dann B nach C u. danach B wieder zu entfernen; statt gleich A nach C zu kopieren?
Sollte dieser Ablauf bestehen bleiben müssen, hast Du lediglich noch die Möglichkeit, unter jede Kopierzeile
Application.CutCopyMode= False zu schreiben u. alle ClearContents-Befehle in einen Gesamt-Range zusammmenzufassen.
Gruß Gerd
Anzeige
AW: Code langsam, geht das schneller?
05.09.2010 20:49:10
Dietmar
Hallo Gerd,
vielen Dank für Deine Rückmeldung.
Ob das Hin und Her so sein muss weiß ich gar nicht so genau; jedenfalls ist mir dazu nichts besseres eingefallen
Application.CutCopyMode= False hatte ich schon ausprobiert, brachte aber nicht wirklich etwas.
Der Code von Hajo hat die Sache deutlich beschleunigt.
Dir noch einen schönen Rest-Sonntag!
VG
Dietmar
Anzeige
AW: Code langsam, geht das schneller?
05.09.2010 20:52:30
Hajo_Zi
Hallo Dietmar,
der Hinweis mit CutCopy war richtig. 
Option Explicit
Sub DerNächsteBitte1()
Dim LoBerechnung As Long
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="123"
LoBerechnung = Application.Calculation
Application.Calculation = xlCalculationManual
On Error GoTo Fehler
Range("M14:O129").Copy
Range("P14:R129").PasteSpecial Paste:=xlPasteValues
Range("P14:R129").Copy
Range("J14:L129").PasteSpecial Paste:=xlPasteValues
Range("P14:R129").ClearContents
Range("AH14:AJ129").Copy
Range("AK14:AM129").PasteSpecial Paste:=xlPasteValues
Range("AK14:AM129").Copy
Range("AE14:AG129").PasteSpecial Paste:=xlPasteValues
Range("AK14:AM129").ClearContents
Range("BC14:BE129").Copy
Range("BF14:BH129").PasteSpecial Paste:=xlPasteValues
Range("BF14:BH129").Copy
Range("AZ14:BB129").PasteSpecial Paste:=xlPasteValues
Range("BF14:BH129").ClearContents
Range("G14:G129").ClearContents
Range("AB14:AB58").ClearContents
Range("AB61:AB129").ClearContents
Range("AW14:AW129").ClearContents
Range("AW9:AX10").ClearContents
Range("AZ1") = "FALSE"    'neu seit 28.07.2009 wg. EC-Zahlungskontrollfeld
Range("F18").Select
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="123"
ActiveSheet.EnableSelection = xlUnlockedCells
Application.Calculation = LoBerechnung
Application.CutCopyMode = False
Exit Sub
Fehler:
MsgBox "Fehler, bitte mit Administrator in Verbindung setzen", vbCritical, "Fehlermeldung"
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="123"
ActiveSheet.EnableSelection = xlUnlockedCells 'neu seit 14.6.2008, nicht bei Zahlenmeldung,  _
da _
diese kopierbar sein muss
Application.CutCopyMode = False
Application.Calculation = LoBerechnung
End Sub

Gruß Hajo
Anzeige
noch schneller: ganz auf "Copy Paste" verzichten
06.09.2010 09:23:17
Klaus
Moin zusammen,
meiner Erfahrung nach ist Copy/Paste über VBA immer relativ langsam, schneller gehts die Bereiche direkt zuzuweisen. Auf meinem Computer ist unten stehende Variante marginal schneller als Hajo's Version.
Sub DerNächsteBitte1()
Dim LoBerechnung As Long
With Application
.ScreenUpdating = False
LoBerechnung = .Calculation
.Calculation = xlCalculationManual
End With
On Error GoTo Fehler
With ActiveSheet
.Unprotect Password:="123"
.Range("P14:R129").Value = .Range("M14:O129").Value
.Range("J14:L129").Value = .Range("P14:R129").Value
.Range("AK14:AM129").Value = .Range("AH14:AJ129").Value
.Range("AE14:AG129").Value = .Range("AK14:AM129").Value
.Range("BF14:BH129").Value = .Range("BC14:BE129").Value
.Range("AZ14:BB129").Value = .Range("BF14:BH129").Value
.Range("BF14:BH129").ClearContents
.Range("AK14:AM129").ClearContents
.Range("P14:R129").ClearContents
.Range("G14:G129").ClearContents
.Range("AB14:AB58").ClearContents
.Range("AB61:AB129").ClearContents
.Range("AW14:AW129").ClearContents
.Range("AW9:AX10").ClearContents
.Range("AZ1") = "FALSE"    'neu seit 28.07.2009 wg. EC-Zahlungskontrollfeld
.Range("F18").Select
.EnableSelection = xlUnlockedCells
.Protect Password:="123"
End With
With Application
.ScreenUpdating = True
.Calculation = LoBerechnung
.CutCopyMode = False
End With
Exit Sub
Fehler:
MsgBox "Fehler, bitte mit Administrator in Verbindung setzen", vbCritical, "Fehlermeldung"
With Application
.ScreenUpdating = True
.Calculation = LoBerechnung
.CutCopyMode = False
End With
End Sub

Anzeige
AW: noch schneller: ganz auf "Copy Paste" verzichten
06.09.2010 13:24:21
JogyB
Hallo Klaus,
bei großen Bereichen ist Copy&Paste deutlich schneller: 
Sub test()
Dim tmr As Double
tmr = Timer
Range("A1:DX65536").Copy Range("DY1")
Debug.Print Timer - tmr
tmr = Timer
Range("DY1:IV65536").Value = Range("A1:DX65536")
Debug.Print Timer - tmr
End Sub

Bei kleinen Bereichen dagegen die direkte Zuweisung: 
Sub test2()
Dim tmr As Double
Dim i As Long
tmr = Timer
For i = 1 To 1000
Range("A1:B5").Copy Range("C1")
Next
Debug.Print Timer - tmr
tmr = Timer
For i = 1 To 1000
Range("C1:D5").Value = Range("A1:B5")
Next
Debug.Print Timer - tmr
End Sub
Gruß, Jogy
Anzeige
AW: noch schneller: ganz auf "Copy Paste" verzichten
06.09.2010 13:48:03
Gerd
Hallo Klaus,
da hast Du wohl die Mehrheit gegen dich. Nichtsdestotrotz gebe ich einer Lösung nach deiner Methode,
solange es nicht um "riesige Bereiche" geht, beim Werte-Transfer wegen der Übersichtlichkeit des Codes
u. weil es so komplett ohne Versatz der Markierung funktioniert, stets den Vorzug.
Gruß Gerd
Anzeige
Hallo Gerd und Jogy ...
06.09.2010 14:22:30
Klaus
... ich war ernsthaft der Überzeugung, dass die Variante .Value = .Value durchgehend schneller ist. In meinen täglichen Makros habe ich Minuten damit gespart, alle "copy pastespecial xlvalues" durch "range(xy).value" und "range(xy).formulaR1C1" zu ersetzen. Andererseits .... ich kopiere viele viele kleine Bereiche in der Gegend herum, was sich mit Jogy's Beobachtung deckt.
Wieder was gelernt, obwohl ich gar nicht der TE bin! Darum bin ich gerne bei Herber.
Dank euch beiden,
Grüße,
Klaus M.vdT.
Anzeige
AW: Hallo Gerd und Jogy ...
06.09.2010 15:25:06
Dietmar
Hallo Klaus,
danke, ich werde das mal checken. Es ist ja auch wesentlich übersichtlicher.
Gruß
Dietmar
AW: noch schneller: ganz auf "Copy Paste" verzichten
06.09.2010 15:29:31
Dietmar
Hallo Klaus,
ich teste das, übersichtlicher ist es jedenfalls.
Der Code von Hajo ist aber wirklich schon beeindruckend schneller als meiner.
VG
Dietmar
AW: Code langsam, geht das schneller?
05.09.2010 10:41:36
Hajo_Zi
Hallo Dietmar,
bei mir läuft der Code unter 1 Sekunde. 
Option Explicit
Sub DerNächsteBitte1()
Dim LoBerechnung As Long
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="123"
LoBerechnung = Application.Calculation
Application.Calculation = xlCalculationManual
On Error GoTo Fehler
Range("M14:O129").Copy
Range("P14:R129").PasteSpecial Paste:=xlPasteValues
Range("P14:R129").Copy
Range("J14:L129").PasteSpecial Paste:=xlPasteValues
Range("P14:R129").ClearContents
Range("AH14:AJ129").Copy
Range("AK14:AM129").PasteSpecial Paste:=xlPasteValues
Range("AK14:AM129").Copy
Range("AE14:AG129").PasteSpecial Paste:=xlPasteValues
Range("AK14:AM129").ClearContents
Range("BC14:BE129").Copy
Range("BF14:BH129").PasteSpecial Paste:=xlPasteValues
Range("BF14:BH129").Copy
Range("AZ14:BB129").PasteSpecial Paste:=xlPasteValues
Range("BF14:BH129").ClearContents
Range("G14:G129").ClearContents
Range("AB14:AB58").ClearContents
Range("AB61:AB129").ClearContents
Range("AW14:AW129").ClearContents
Range("AW9:AX10").ClearContents
Range("AZ1") = "FALSE"    'neu seit 28.07.2009 wg. EC-Zahlungskontrollfeld
Range("F18").Select
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="123"
ActiveSheet.EnableSelection = xlUnlockedCells
Application.Calculation = LoBerechnung
Exit Sub
Fehler:
MsgBox "Fehler, bitte mit Administrator in Verbindung setzen", vbCritical, "Fehlermeldung"
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="123"
ActiveSheet.EnableSelection = xlUnlockedCells 'neu seit 14.6.2008, nicht bei Zahlenmeldung,  _
da _
diese kopierbar sein muss
Application.Calculation = xlCalculationAutomatic
End Sub

Anzeige
WOW!
05.09.2010 20:45:52
Dietmar
Hallo Hajo,
JA, geht deutlich schneller ... und irgendwie auch geschmeidiger ... das bilde ich mir dann wohl aber nur ein :-)
Also: herzlichen Dank!
Viele Grüße
Dietmar aus Aachen
AW: WOW!
05.09.2010 20:49:07
Hajo_Zi
Hallo Ditmar,
die letzte Zeile ist noch falsch
nicht
Application.Calculation = xlCalculationAutomatic
sonder
Application.Calculation = LoBerechnung
damit der Berechnungsmodsus so ist wie beim Start des Makros.
Gruß Hajo
Anzeige
DANKE!
05.09.2010 20:52:46
Dietmar
Hallo Hajo,
Du kennst wohl auch keinen Sonntag im Sinne von "Nichts tun" :-)
Das ist ja echt klasse, dass Du daran noch gedacht hast! Vielen Dank! Werde ich noch anpassen.
Noch einen schönen Sonntagabend!
Liebe Grüße
Dietmar
AW: Code optimiert
05.09.2010 23:53:58
Daniel
Hi
probier mal, ob dieser Code nicht das gleiche bewirkt:
Sub DerNächsteBitte1()
Dim LoBerechnung As Long
ActiveSheet.Unprotect Password:="123"
LoBerechnung = Application.Calculation
Application.Calculation = xlCalculationManual
On Error GoTo Fehler
With Intersect(Range("14:129"), Range("J:L,AE:AG,AZ:BB"))
.Formula = "=if(RC[3]="""","""",RC[3])"
.Formula = .Value
End With
Intersect(Range("14:129"), Range("G:G,P:R,AK:AM,BF:BH,AW:AW")).ClearContents
Range("AB14:AB58,AB61:AB129,AW9:AX10").ClearContents
Range("AZ1") = "FALSE"    'neu seit 28.07.2009 wg. EC-Zahlungskontrollfeld
Range("F18").Select
ActiveSheet.Protect Password:="123"
ActiveSheet.EnableSelection = xlUnlockedCells
Application.Calculation = LoBerechnung
Exit Sub
Fehler:
MsgBox "Fehler, bitte mit Administrator in Verbindung setzen", vbCritical, "Fehlermeldung" _
Application.ScreenUpdating = True
ActiveSheet.Protect Password:="123"
ActiveSheet.EnableSelection = xlUnlockedCells 'neu seit 14.6.2008, nicht bei  _
Zahlenmeldung, _
da _
diese kopierbar sein muss
Application.Calculation = LoBerechnung
End Sub
gruß, Daniel
Anzeige
AW: Code optimiert
06.09.2010 15:31:35
Dietmar
Hallo Daniel,
Dein Code ist ja beeindruckend kurz.
Ich werde Ihn testen!
VG
Dietmar
;
Anzeige

Infobox / Tutorial

Code optimieren: Schnellere Makros in Excel

Schritt-für-Schritt-Anleitung

  1. Makro öffnen: Starte Excel und öffne dein Makro im VBA-Editor.
  2. Bildschirmaktualisierung deaktivieren: 
    Application.ScreenUpdating = False
  3. Berechnung auf manuell setzen: 
    Application.Calculation = xlCalculationManual
  4. Kopieren und Einfügen: Verwende die .Value Zuweisung anstelle von Copy/Paste, um die Geschwindigkeit zu erhöhen. Beispiel: 
    Range("P14:R129").Value = Range("M14:O129").Value
  5. ClearContents zusammenfassen: Reduziere die Anzahl der ClearContents-Befehle, indem du sie in einem einzigen Befehl zusammenfasst.
  6. Makro abschließen: 
    Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

    Stelle sicher, dass du Application.CutCopyMode = False verwendest, um den Kopiermodus zu beenden.

Häufige Fehler und Lösungen

  • Kopierfehler: Wenn du Copy/Paste verwendest, achte darauf, dass der CutCopyMode deaktiviert ist. Füge Application.CutCopyMode = False nach jedem Kopiervorgang hinzu.

  • Langsame Ausführung: Wenn ein Makro langsam läuft, überprüfe, ob die Berechnung auf manuell gesetzt ist und die Bildschirmaktualisierung deaktiviert ist.

  • Fehlermeldungen: Achte darauf, dass alle Bereiche, die du kopierst oder leerst, korrekt definiert sind. Ein Fehler in den Bereichsnamen kann zu Laufzeitfehlern führen.

Alternative Methoden

  • Direkte Zuweisung: Anstatt Copy/Paste zu verwenden, kannst du direkt Werte zuweisen:

    Range("Zielbereich").Value = Range("Quellbereich").Value

  • Array-Zuweisung: Bei großen Datenmengen kannst du auch mit Arrays arbeiten, um die Geschwindigkeit zu erhöhen:

    Dim arr As Variant
arr = Range("Quellbereich").Value
Range("Zielbereich").Value = arr

Praktische Beispiele

Hier sind einige optimierte Beispiele, die die oben genannten Methoden veranschaulichen:

Beispiel 1: Copy/Paste optimiert

Sub OptimiertesMakro()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Direktes Zuweisen
    Range("P14:R129").Value = Range("M14:O129").Value
    Range("J14:L129").Value = Range("P14:R129").Value

    ' ClearContents in einem Befehl
    Range("G14:G129, AB14:AB58, AB61:AB129, AW14:AW129").ClearContents

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Beispiel 2: Verwendung von CutCopyMode

Sub BeispielMitCutCopyMode()
    ' Beispiel, um CutCopyMode zu beenden
    Range("A1:B2").Copy Range("C1")
    Application.CutCopyMode = False
End Sub

Tipps für Profis

  • Nutze Profiling-Tools, um herauszufinden, welche Teile deines Codes am meisten Zeit in Anspruch nehmen.
  • Halte deine Code-Strukturen sauber und verwende Kommentare, um die Lesbarkeit zu erhöhen.
  • Teste verschiedene Ansätze (Copy/Paste vs. .Value) und vergleiche die Ausführungszeiten, um die beste Methode für deine spezifischen Anforderungen zu finden.

FAQ: Häufige Fragen

1. Wie kann ich die Ausführungszeit meines Makros messen?
Du kannst die Zeitmessung mit der Timer-Funktion durchführen:

Dim tmr As Double
tmr = Timer
' Dein Code hier
Debug.Print Timer - tmr

2. Was tun, wenn mein Makro immer noch langsam ist?
Überprüfe, ob du unnötige Bildschirmaktualisierungen oder Berechnungen hast. Verwende Application.ScreenUpdating = False und Application.Calculation = xlCalculationManual, um die Leistung zu verbessern.

3. Wie gehe ich mit Copy-Paste-Fehlern um?
Stelle sicher, dass der Quellbereich korrekt definiert ist und dass du Application.CutCopyMode = False verwendest, um den Kopiermodus zu beenden und Fehler zu vermeiden.

Beliebteste Forumthreads (12 Monate)

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