Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1588to1592
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

Formate und Werte "schneller" kopieren

Formate und Werte "schneller" kopieren
14.11.2017 09:25:28
Tobias
Moin zusammen!
Kann man das hier noch etwas beschleunigen?
Der Befehl .copy destination:= ... funktioniert ja nicht, da ich Formate und Werte kopieren will. Oder?
'optimale Zeilenhöhe automatisch anpassen
'zunächst kopieren der zusammenhängen Spalten ab C in Spalte U (eizelne Spalte) mitsamt Werten und Formaten
For s = 1 To RangÜbersichtEnde
If s = 1 Then
With Worksheets("Test")
.Range("C" & 32).Copy
.Range("U" & 32).PasteSpecial Paste:=xlValues
.Range("U" & 32).PasteSpecial Paste:=xlFormats
.Rows("32").EntireRow.AutoFit
.Range("C" & 35).Copy
.Range("U" & 35).PasteSpecial Paste:=xlValues
.Range("U" & 35).PasteSpecial Paste:=xlFormats
.Rows("35").EntireRow.AutoFit
.Range("C" & 38).Copy
.Range("U" & 38).PasteSpecial Paste:=xlValues
.Range("U" & 38).PasteSpecial Paste:=xlFormats
.Rows("38").EntireRow.AutoFit
.Range("C" & 41).Copy
.Range("U" & 41).PasteSpecial Paste:=xlValues
.Range("U" & 41).PasteSpecial Paste:=xlFormats
.Rows("41").EntireRow.AutoFit
End With
Else
With Worksheets("Test")
.Range("C" & 32 + i * 34).Copy
.Range("U" & 32 + i * 34).PasteSpecial Paste:=xlValues
.Range("U" & 32 + i * 34).PasteSpecial Paste:=xlFormats
.Rows("32 + i * 34").EntireRow.AutoFit
.Range("C" & 35 + i * 34).Copy
.Range("U" & 35 + i * 34).PasteSpecial Paste:=xlValues
.Range("U" & 35 + i * 34).PasteSpecial Paste:=xlFormats
.Rows("35 + i * 34").EntireRow.AutoFit
.Range("C" & 38 + i * 34).Copy
.Range("U" & 38 + i * 34).PasteSpecial Paste:=xlValues
.Range("U" & 38 + i * 34).PasteSpecial Paste:=xlFormats
.Rows("38 + i * 34").EntireRow.AutoFit
.Range("C" & 41 + i * 34).Copy
.Range("U" & 41 + i * 34).PasteSpecial Paste:=xlValues
.Range("U" & 41 + i * 34).PasteSpecial Paste:=xlFormats
.Rows("41 + i * 34").EntireRow.AutoFit
End With
End If
Next s
Viele Grüße!

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Formate und Werte "schneller" kopieren
14.11.2017 09:30:31
Tobias
Abgesehen davon, dass das i natürlich s sein muss.
Zudem läuft mein Befehl .Rows("32 + s * 34").EntireRow.AutoFit etc. wohl irgendwie nicht. -.-
AW: Formate und Werte "schneller" kopieren
14.11.2017 09:40:11
Tobias
Okay, sorry für das Durcheinander. Leider kann ich meine Beiträge nicht bearbeiten.
Der Code sieht nun so aus:
'optimale Zeilenhöhe automatisch anpassen
'zunächst kopieren der zusammenhängen Spalten ab C in Spalte U (eizelne Spalte) mitsamt Werten und Formaten
For s = 1 To RangÜbersichtEnde
If s = 1 Then
With Worksheets("test")
.Range("C" & 32).Copy
.Range("U" & 32).PasteSpecial Paste:=xlValues
.Range("U" & 32).PasteSpecial Paste:=xlFormats
.Rows("32").EntireRow.AutoFit
.Range("C" & 35).Copy
.Range("U" & 35).PasteSpecial Paste:=xlValues
.Range("U" & 35).PasteSpecial Paste:=xlFormats
.Rows("35").EntireRow.AutoFit
.Range("C" & 38).Copy
.Range("U" & 38).PasteSpecial Paste:=xlValues
.Range("U" & 38).PasteSpecial Paste:=xlFormats
.Rows("38").EntireRow.AutoFit
.Range("C" & 41).Copy
.Range("U" & 41).PasteSpecial Paste:=xlValues
.Range("U" & 41).PasteSpecial Paste:=xlFormats
.Rows("41").EntireRow.AutoFit
End With
Else
With Worksheets("test"
.Range("C" & 32 + (s - 1) * 34).Copy
.Range("U" & 32 + (s - 1) * 34).PasteSpecial Paste:=xlValues
.Range("U" & 32 + (s - 1) * 34).PasteSpecial Paste:=xlFormats
.Rows("32+(s - 1)*34").EntireRow.AutoFit
.Range("C" & 35 + (s - 1) * 34).Copy
.Range("U" & 35 + (s - 1) * 34).PasteSpecial Paste:=xlValues
.Range("U" & 35 + (s - 1) * 34).PasteSpecial Paste:=xlFormats
.Rows("35 + (s - 1) * 34").EntireRow.AutoFit
.Range("C" & 38 + (s - 1) * 34).Copy
.Range("U" & 38 + (s - 1) * 34).PasteSpecial Paste:=xlValues
.Range("U" & 38 + (s - 1) * 34).PasteSpecial Paste:=xlFormats
.Rows("38 + (s - 1) * 34").EntireRow.AutoFit
.Range("C" & 41 + (s - 1) * 34).Copy
.Range("U" & 41 + (s - 1) * 34).PasteSpecial Paste:=xlValues
.Range("U" & 41 + (s - 1) * 34).PasteSpecial Paste:=xlFormats
.Rows("41 + (s - 1) * 34").EntireRow.AutoFit
End With
End If
Next s
Bei .Rows("32+(s - 1)*34").EntireRow.AutoFit und ähnlichen kommt ein Debug-Fehler, da "typen unverträglich". ich nehme an, dass das daran liegt, dass die Zeile schon eine gute Höhe hat und für den Text groß genug ist. Kann man die Fehlermeldung irgendwie umgehen? Es kann nämlich sein, dass bei dem nächsten Aufrufen des Makros der Text zu groß ist. Es ist also man so und mal so.
Anzeige
AW: noch ein Tip
14.11.2017 10:42:53
Daniel
Dein IF-THEN ist überflüssig.
da bei s = 1 der Ausdruck 32 + (s - 1) * 34 ebenfalls 32 ergibt, brauchst du diese Unterscheidung nicht.
Gruß Daniel
AW: Formate und Werte "schneller" kopieren
14.11.2017 09:58:38
Daniel
Hi
zu deiner Zusatzfrage:
wenn du eine Berechnung hast, darfst du diese natürlich nicht in Anführungszeichen setzen, denn sonst ist das Text!
Die Funktion Rows verarbeitet auch Ganzzahlen als Zeilennummer, daher: ...Rows(32 + s * 34)...
was ein bisschen seltsam ist in deinem Code:
die Schleife läuft über die Variable s, aber im Code verwendest du dann die Variable i, welche sich aber im Schleifenverlauf nicht ändert.
Wenn man solche Vorgänge beschleunigen will, müsstest du die Tabelle vor dem Kopierern so umsortieren, dass alle Zellen, die kopiert werden müssen, möglichst lückenlose Blöcke bilden.
der Befehl
.range("C32").copy
.Range("U32").PasteSpecial xlpastevalues

dauert genauso lange wie
.Range("C32:C100").Copy
.Range("U32:U100").PasteSpecial xlpastevalues
nach dem kopieren kannst du die Liste ja wieder in die Ursprungsreihenfolge zurücksortieren.
und ja, das geht auch per Marko!
ggf musst du Hilfsspalten, in welchen du die Ursprungsreihenfolge sicherst und die Temporäre Reihenfolge festlegst, verwenden, aber diese Hilfsspalten kannst du ja auch im Code einfügen und wieder löschen.
Gruß Daniel
(dh alle Zeilen, die jetzt 34 Zeilen abstand haben, müssen direkt untereinander stehen)
Wenn das der Fall ist, kannst du jeden Block in einem Schritt kopieren und brauchst keine Schleife über jede Zelle
Anzeige
AW: Formate und Werte "schneller" kopieren
14.11.2017 10:01:02
Tobias
Okay, super!
Vielen Dank für die Info! Ich werde das mal probieren!
AW: Formate und Werte "schneller" kopieren
14.11.2017 12:32:28
Daniel
Hi
probier mal diesen Code:
durch das Sortieren sollte nicht nur der Ablauf schneller werden, sondern der Code wird auch kürzer.
(das wird er dadurch, dass ein Teil der Rechenlogik in die Formel verlagert wird)
Sub test()
Dim Spalte As Long
Dim Zeile As Long
With Sheets("Test")
With .Cells.SpecialCells(xlCellTypeLastCell)
Zeile = .Row
Spalte = WorksheetFunction.Max(22, .Column)
End With
'--- Sortierreihenfolgen festlegen
With .Range(.Cells(32, Spalte), .Cells(Zeile, Spalte + 1))
.Columns(1).FormulaR1C1 = "=Row()"
.Columns(2).FormulaR1C1 = "=IF(OR(MOD(ROW(),34)={32;1;4;7}),1,""x"")"
.Formula = .Value
'--- sortieren
.EntireRow.Sort key1:=.Cells(1, 2), order1:=xlAscending, Header:=xlNo
'--- Werte und Formate aus Spalte C nach Spalte U kopieren
With .Columns(2).SpecialCells(xlCellTypeConstants, 1).EntireRow
.Columns(3).Copy
.Columns(21).PasteSpecial xlPasteValues
.Columns(21).PasteSpecial xlPasteFormats
End With
'--- Rücksortieren in Originalreihenfolge
.EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
'--- Hilfsspalte löschen
.ClearContents
End With
End With
End Sub
Gruß Daniel
Anzeige
AW: noch ein Fehler
14.11.2017 12:35:01
Daniel
bitte korrigiere diese Zeile so:
Spalte = WorksheetFunction.Max(22, .Column + 1)
ansonsten könnte es sein, dass du dir die letzte genutzte Spalte überschreibst.
Gruß Daniel
AW: noch ein Fehler
14.11.2017 12:40:15
Tobias
"Für diese Aktion müssen alle verbundenen Zellen dieselbe Größe haben." kommt bei der Zeile
'--- sortieren
.EntireRow.Sort key1:=.Cells(1, 2), order1:=xlAscending, Header:=xlNo
als Fehler.
Habe leider verbundene Zellen dort, die ich auch nicht anders gestalten kann. Würde gerne die Datei online stellen, aber das ist mir leider nicht erlaubt.
mal wieder Verbundzellen
14.11.2017 13:01:09
Daniel
dann siehe meinen anderen Beitrag, es gibt noch Möglichkeiten, den Ablauf zu beschleunigen.
Trotzdem solltest du mal in einer Testdatei die Verbundzellen aufheben und mein Makro laufen lassen, damit du die Geschwindikeitsunterschiede merkst.
Vielleicht motiviert dich das, darüber nachzudenken, wie du ohne Verbundzellen auskommen könntest ;-)
Gruß Daniel
Anzeige
wenn das mit dem Sortieren nicht klappt
14.11.2017 12:55:01
Daniel
... könntest du deinen Code noch so etwas schneller machen:
1. kontrolliere, ob RangÜbersichtEnde die letzte Zeilennummer enthält oder den Wert (LetzteZeilennummer-32) / 34
da du mit 34 multiplizierst, muss die Schleife nur bis zu diesem Wert laufen und nicht bis zur letzten Zeilennummer
2. stelle an den Anfang des Codes:
Application.ScreenUpdating = False
Application.EnableEvent = False
Application.Calculation = xlcalculationmanual

und am ende dann:
Application.ScreenUpdating = True
Applciation.EnableEvents = True
Application.Calculation = xlcalculation.Automatic
beim jedem Einfügen eines Wertes muss Excel eine Reihe von Aktionen durchführen, welche viel Zeit verbrauchen.
Einige von diesen Aktionen kann man aber abschalten, bzw dafür sorgen, dass diese nicht bei jedem Einfügen eines Wertes ausgeführt werden, sondern erst am Ende des Makros.
Der Ablauf wird dadurch schneller.
mein Sortiermakro ist auch deswegen so schnell, weil es durch das Sortieren mit zwei Einfügeoperationen (Werte und Formate) auskommt und somit die o.g. Aktionen sowieso nur 2x ausgeführt werden.
Gruß Daniel
Anzeige

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige