Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1172to1176
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
Inhaltsverzeichnis

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

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
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
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
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
Anzeige
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

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige