Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
24.04.2024 18:49:56
Anzeige
Archiv - Navigation
1400to1404
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

Kopierschleife optimieren

Kopierschleife optimieren
09.01.2015 09:52:21
Paul#235
Hallo VBA-Profis,
ich möchte aus einem Bereich in Tabelle 1 Werte in Tabelle 2 kopieren. Einziges Manko, ich möchte nur die Werte kopieren, deren Zellen nicht Orange hinterlegt sind (unterschiedliche Anordnung), Zellen die Orange hinterlegt sind, dürfen nicht kopiert werden, da in Tabelle 2 an dieser Stelle Formeln stehen. Für dieses Szenario hab ich mir eine Schleife geschrieben. Diese braucht jedoch zum Ausführen ca. 10 sec.
Frage: gibt es eine möglichkeit den Code zu optimieren/umzuschreiben sodass die Zeit wesentlich kürzer wird?
Sub kopieren()
Dim rng1 As Range
Dim zeile As Integer
Dim spalte As Integer
For Each rng1 In ThisWorkbook.Sheets("Tabelle1").Range("C142:O275")
If rng1.Interior.Color  RGB(250, 191, 143) Then
rng1.Copy
zeile = Range(rng1.Address).Row
spalte = Range(rng1.Address).Column
Sheets("Tabelle2").Cells(zeile - 136, spalte).PasteSpecial xlPasteValues
End If
Next rng1
Application.CutCopyMode = False
End Sub
Grüße Paul

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kopierschleife optimieren
09.01.2015 10:06:20
selli
hallo paul,
kann sein, dass deine mappe sehr umfangreich ist.
deshalb zu beginn screenupdates und automatische berechnungen ausschalten und am ende des codes wieder einschalten.
Sub kopieren()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim rng1 As Range
Dim zeile As Integer
Dim spalte As Integer
For Each rng1 In ThisWorkbook.Sheets("Tabelle1").Range("C142:O275")
If rng1.Interior.Color  RGB(250, 191, 143) Then
rng1.Copy
zeile = Range(rng1.Address).Row
spalte = Range(rng1.Address).Column
Sheets("Tabelle2").Cells(zeile - 136, spalte).PasteSpecial xlPasteValues
End If
Next rng1
Application.CutCopyMode = False
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

gruß
selli

Anzeige
AW: Kopierschleife optimieren
09.01.2015 10:07:56
Rudi
Hallo,
schalte die autom. Berechnung und die Bildschirmaktualisierung aus.
Gruß
Rudi

AW: Kopierschleife optimieren
09.01.2015 10:09:09
Luschi
Hallo Paul,
bei Kopieraktionen per Vba sollte man immer 3 Geschwindigkeitsbremsen vor derOperation
ausschalten und hinterher wieder aktivieren:
- Bildschirmaktualisierung
- automatische Berechnung der Formeln
- spezielle Excel-Ereignisroutinen
Mehr dazu findest Du hier:

https://www.herber.de/forum/archiv/976to980/977234_Sub_GetMoreSpeed_intCalculation.html

Außerdem ist das hier doppelt-gemoppelt:
zeile = Range(rng1.Address).Row
spalte = Range(rng1.Address).Column
und kann man so schreiben
zeile = rng1.Row
spalte = rng1.Column
Gruß von Luschi
aus kilein-Paris

Anzeige
AW: Kopierschleife optimieren
09.01.2015 10:22:50
Paul#235
Vielen dank erstmal für die schnelle reaktion...
leider hatte ich in meinem code vergessen anzugeben dass ich in meiner Excel Datei bereits die Bildschirmaktualisierung, Berechnungen und Events ausgeschaltet habe...
auch wenn ich
zeile = Range(rng1.Address).Row
spalte = Range(rng1.Address).Column
durch
zeile = rng1.Row
spalte = rng1.Column
ersetze wird der Code nicht wesentlich schneller
Momentan bin ich bei einer Zeit von ca 8,6 sec.
gibt es noch weitere Möglichkeiten um den Code schneller zu machen?

AW: Kopierschleife optimieren
09.01.2015 10:29:16
hary
Moin
Versuch mal statt copy nur Value uebergeben.
Also statt
 rng1.Copy
zeile = Range(rng1.Address).Row
spalte = Range(rng1.Address).Column
Sheets("Tabelle2").Cells(zeile - 136, spalte).PasteSpecial xlPasteValues

einfach nur
Sheets("Tabelle2").Cells(rng1.Row - 136, rng1.Column).Value = rng1.Value

gruss hary

Anzeige
AW: Kopierschleife optimieren
09.01.2015 10:44:41
Paul#235
Fuck... Yeah!!!!
vielen vielen dank... darauf bin ich selber leider nicht gekommen.
Die Zeit liegt nun bei unter 0,5 sec. und damit kann ich sehr gut leben
Vielen dank nochmal!

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige