Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 10:08:11
Summieren von Zellen mit bedingter Formatierung
26.04.2024 09:08:00
Export alle Tabellenblätter als csv - in bestimmten Ordner
26.04.2024 08:56:40
Über alle Spalten nur €-Werte zählen
26.04.2024 08:08:24
Pivot Vormonatsveränderung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1620to1624
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1620to1624
1620to1624
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro mi vielen Kopieranweisungen langsam

Makro mi vielen Kopieranweisungen langsam
03.05.2018 15:11:56
Lukas
Hallo zusammen,
folgender Code: 

Sub MAIN()
Worksheets(1).Range("G11").Value = "Suche läuft..."
Dim i As Integer
Dim j As Integer

For i = 3 To Worksheets(1).Range("N2").Value + 2
Worksheets(2).Range("D3").Value = Worksheets(4).Cells(i, 15).Value
Worksheets(2).Range("E3").Value = Worksheets(4).Cells(i, 16).Value
Worksheets(2).Range("KLänge").Value = Worksheets(4).Cells(i, 17).Value
Worksheets(2).Range("KBreite").Value = Worksheets(4).Cells(i, 18).Value
Worksheets(2).Range("KHöhe").Value = Worksheets(4).Cells(i, 19).Value
For j = 21 To 47
Worksheets(4).Cells(i, j).Value = Worksheets(2).Cells(9, j + 3).Value
Next j
Next i
Range("N4:P9").Value = Range("B5:D10").Value
With Range("N4:P9").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Range("N4:P9").Borders(xlDiagonalDown).LineStyle = xlNone
Range("N4:P9").Borders(xlDiagonalUp).LineStyle = xlNone
Range("N4:P9").Borders(xlEdgeLeft).LineStyle = xlNone
Range("N4:P9").Borders(xlEdgeTop).LineStyle = xlNone
Range("N4:P9").Borders(xlEdgeBottom).LineStyle = xlNone
Range("N4:P9").Borders(xlEdgeRight).LineStyle = xlNone
Range("N4:P9").Borders(xlInsideVertical).LineStyle = xlNone
Range("N4:P9").Borders(xlInsideHorizontal).LineStyle = xlNone
Worksheets(1).Range("G11").Clear
End Sub

Relevant ist der fette Teil. Der Rest nur zu Vollständigkeit.
Wenn ich dieses Makro ausführe braucht mein Arbeitsrechner nachgemessene 2:15 Minuten. Das ist unzumutbar für meine Kollegen, vorallem vor dem Hintergrund, dass ich einer der Wenigen bin, der noch mit Stand-PC arbeitet. Der Trend geht zum hauchdünnen Laptop mit halber Rechenleistung für das doppelte Geld.
Ich habe schon diesen Befehl probiert:
Worksheets(4).Range(Cells(i, 21), Cells(i, 47)).Value = Worksheets(2).Range("X9:AX9").Value
Als Einzelschritt funktioniert das. Wenn ich das ganze Makro ausführe, kommt Laufzeitfehler '1004'
Kann mir jemand sagen was ich falsch gemacht habe?
Danke im Voraus! LG Lukas

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro mi vielen Kopieranweisungen langsam
03.05.2018 15:59:32
Daniel
HI
wenn du per Range(Cells(), Cells()) zellen auf einem nichtaktiven Blatt ansprechen willst, dann muss die Blatteferenz vor den beiden Cells stehen. Zellbezüge ohne Blattangabe beziehen sich auf das gerade aktive Blatt, das gilt auch für Zellbezüge, die innerhalb von Funktionen stehen.
Vor der Range kann die Blattrefernz entfallen, wenn der Code in einem allgemeinen Modul steht: 
Range(Worksheets(4).Cells(i, 21), Worksheets(4).Cells(i, 47)).Value = ...

im Einzelstep hats funktioniert, weil du vermutlich das Worksheet(4) aktiviert hast und somit die Cells auf das richtige Blatt referenziert haben.
ich würde hier mit Resize arbeiten um die Formel kurz zu halten: 
worksheets(4).Cells(i, 21).Resize(1, 27).Value= Worksheets(2).Cells(9, 24).Resize(1, 27).Value
oder mit copy-Paste, da muss du vom Zielbereich nur die erste Zelle angeben: 
Worksheets(2).range("X9:AX9").Copy
Worksheets(4).Cells(i, 21).PasteSpecial xlpastevalus

Gruß Daniel
Anzeige
AW: Makro mi vielen Kopieranweisungen langsam
03.05.2018 16:15:27
Lukas
Hi Daniel,
Danke für die schnelle Antwort!!! Mir war nicht klar, dass die Cells dann noch die Worksheets brauchen.
Habe das Makro mit deiner Resize Version auf 28 Sekunden bekommen. Damit kann ich schonmal besser leben. Aber ob es viel schneller geht, steht noch in den Sternen. Schließlich werden da 972 Zellen kopiert.
LG Lukas
AW: Makro mi vielen Kopieranweisungen langsam
03.05.2018 16:26:47
Daniel
Hi
prinzipell sollte man Schleifen zum Bearbeiten von Excelzellen vermeiden und Excelzellen möglichst als Block in einem Schritt bearbeiten.
Wenn ich deinen Code richtig interpretiere, dann wird sich die äußere Schleife aber kaum eleminieren lassen, weil du hier Berechnungen mit vielen Eingabeparametern in einem Formblatt durchführst und dann die Ergebnisse in ein Protokoll überführst.
Den ersten Teil könntest du noch Optimieren, wenn du die eingabezellen auf Blatt (D2, E3, Klänge, KHöhe, KBreite) so anordnest, dass sie gleich angeordnet sind wie Zellen aus Blatt 4, dann könntest du sie nämlich auch in einem Schritt übertragen: 
Worksheets(2).Range("D3").Resize(1, 5).Value = Worksheets(4).Cells(i, 15).Resize(1, 5).Value
wenn sich die Anordnung nicht ändern lässt, könntest du in die Eingabezellen (D2, E3, Klänge, KHöhe, KBreite) noch einen Zellbezug auf einen freien Zellbereich setzen, der aber so angeordnet ist und dann die Werte aus Blatt 4 dorthin kopieren.
gruß Daniel
Anzeige
AW: Makro mi vielen Kopieranweisungen langsam
03.05.2018 16:54:27
Lukas
Hi Daniel,
Genau richtig erkannt. Die Berechnung ist zu komplex um sie in Spalten direkt hinter die Parameter zu packen. Deswegen so.
Der Code sieht jetzt so aus:
Sub MAIN()
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Worksheets(1).Range("G12").Clear
Worksheets(1).Range("G11").Value = "Suche läuft..."
Dim i As Integer
For i = 3 To Worksheets(1).Range("N2").Value + 2
Worksheets(2).Range("D3:H3").Value = Worksheets(4).Cells(i, 15).Resize(1, 5).Value
Worksheets(4).Cells(i, 21).Resize(1, 27).Value = Worksheets(2).Cells(9, 24).Resize(1, 27). _
Value
Next i
Worksheets(1).Range("N4:P9").Value = Worksheets(1).Range("B5:D10").Value
With Worksheets(1).Range("N4:P9").Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Worksheets(1).Range("N4:P9").Borders(xlDiagonalDown).LineStyle = xlNone
Worksheets(1).Range("N4:P9").Borders(xlDiagonalUp).LineStyle = xlNone
Worksheets(1).Range("N4:P9").Borders(xlEdgeLeft).LineStyle = xlNone
Worksheets(1).Range("N4:P9").Borders(xlEdgeTop).LineStyle = xlNone
Worksheets(1).Range("N4:P9").Borders(xlEdgeBottom).LineStyle = xlNone
Worksheets(1).Range("N4:P9").Borders(xlEdgeRight).LineStyle = xlNone
Worksheets(1).Range("N4:P9").Borders(xlInsideVertical).LineStyle = xlNone
Worksheets(1).Range("N4:P9").Borders(xlInsideHorizontal).LineStyle = xlNone
Worksheets(1).Range("G11").Clear
SecondsElapsed = Round(Timer - StartTime, 2)
Worksheets(1).Range("G12").Value = "Der letzte Suchlauf dauerte " & SecondsElapsed & " Sekunden" _
End Sub
Mir sind die Augen aus dem Kopf gefallen, als ich 0,89 Sekunden maß!
Ergebnisse sind korrekt. So soll es eigentlich sein!
Vielen Vielen Dank Daniel!
Anzeige
AW: Makro mi vielen Kopieranweisungen langsam
03.05.2018 18:17:48
Daniel
Hi
wie gesagt, jeder Übertrag der Werte von Blatt 4 nach Blatt 2 löst eine Neuberechung deines Formlwerks aus.
Durch die gebündelte Übertragung wird jetzt pro Schleifenumlauf der Hauptschleife nur 1x anstatt 5x gerechnet

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige