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

Performance beim Kopieren steigern.

Performance beim Kopieren steigern.
23.06.2016 09:27:54
Peter
Hallo,
ich kopiere mir derzeit mit Beispiel1.Range("B2").Value = Beispiel2.Cells(i, 9).Value in einer Schleife etwa 1000 Werte.
Da Excel ja anscheinend jedes mal das eine Worksheet öffnet, den Kram reinkopiert, wieder schließt etc. pp... dauert das ganze sehr sehr lange (etwa 1 Minute).
Meine Idee war jetzt, die Werte, die ich von dem einen Worksheet in das andere Worksheet kopieren will in ein Array einzulesen und dann praktisch im Arbeitsspeicher den Kram rüberschreibe, meine Aktion ausführe und die Werte dann wieder übergebe.
Mein Kopier-Code sieht derzeit so aus (gekürzt):
For i = 3 To Beispiel2.Cells(Rows.Count, 9).End(xlUp).Row
wsBeispiel1.Range("B2").Value = wsBeispiel2.Cells(i, 9).Value
wsBeispiel1.Range("B3").Value = wsBeispiel2.Range("A17").Value
wsMustertabelleMetafile.Range("B4").Value = wsBeispiel1.Range("Q3").Value
sVersion = DateValue(wsDateneingabe_Dashboard.Range("Q4").Value)
wsBeispiel1.Range("B5").Value = Format(sVersion, "'YYYY-MM-DD")
Call Fuktion
Next i
Jetzt ist die Frage, wie ich das ganze realisiere.
Habe dazu diesen Code gefunden.
Sub bspArray()
Dim varArr As Variant
Dim arr1, arr2
Dim dteStart As Date, dteEnde As Date
Dim appendedText As String
appendedText = "123"
Application.ScreenUpdating = False
dteStart = Timer
varArr = Range(Cells(1, 1), Cells(100, 100))
For arr1 = 1 To 100
For arr2 = 1 To 100
varArr(arr1, arr2) = varArr(arr1, arr2) & appendedText
Next arr2
Next arr1
Range(Cells(1, 1), Cells(100, 100)) = varArr
dteEnde = Timer
Application.ScreenUpdating = True
Debug.Print "Bearbeitungszeit: " & Format _
(dteEnde - dteStart, "0.00") & " Sekunden..."
End Sub

Allerdings tue ich mich grade etwas schwer die einzelnen Worksheets im Arbeitsspeicher zu lassen und nicht, wie ich es sonst getan habe, zu öffnen.
Vielen Dank im Voraus
Peter

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Performance beim Kopieren steigern.
23.06.2016 09:34:03
Peter
Hallo nochmal,
mir kam jetzt grade noch die Idee die einzelnen Worksheets in ein Array über varArr = Range(Cells(1, 1), Cells(100, 100)) einzulesen und dann die zu ändernden Werte über diverse Zähler reinzuschreiben?
Ist das so möglich bzw sinnvoll?
Grüße
Peter

AW: Performance beim Kopieren steigern.
23.06.2016 15:01:43
Peter
Gesagt, getan.
Sub MakeSheet()                                                         'Funktion erzeugt  _
Tabelle mit
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim dteStart As Date, dteEnde As Date
dteStart = Timer
Dim i As Integer
Dim varArr1, varArr2, varArr3 As Variant
Beispiel1.Activate
varArr1 = Beispiel1.Range(Cells(1, 1), Cells(100, 100))
Beispiel2.Activate
varArr2 = Beispiel2.Range(Cells(1, 1), Cells(24, 11))
Beispiel3.Activate
varArr3 = Beispiel3.Range(Cells(1, 1), Cells(3, 3))
For i = 3 To Beispiel1.Cells(Rows.Count, 9).End(xlUp).Row                          ' _
Debug.Print "Reihe: " & Format(i) & "    " & Format(Now())
varArr2(2, 2) = varArr1(i, 9)
varArr2(3, 2) = varArr1(17, 1)
varArr2(4, 2) = varArr1(3, 17)
sVersion = DateValue(varArr1(4, 17))
varArr2(5, 2) = Format(sVersion, "'YYYY-MM-DD")
varArr2(6, 2) = varArr1(5, 17)
varArr2(7, 2) = varArr1(6, 17)
sTimestampMetafile = DateValue(varArr1(8, 3)) + TimeValue(varArr1(8, 3))
varArr2(8, 2) = Format(sTimestampMetafile, "YYYYMMDD_hhmmss")
varArr2(16, 11) = varArr1(i, 12)
varArr2(17, 11) = varArr1(i, 10)
varArr2(14, 8) = varArr1(i, 9)
varArr2(15, 8) = varArr1(i, 15)
varArr2(15, 9) = varArr1(i, 15)
varArr2(15, 9) = varArr1(i, 15)
Beispiel1.Activate
Beispiel1.Range(Cells(1, 1), Cells(100, 100)) = varArr1
Beispiel2.Activate
Beispiel2.Range(Cells(1, 1), Cells(24, 11)) = varArr2
Call Beispiel.Beispiel
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
dteEnde = Timer
Debug.Print "Bearbeitungszeit: " & Format _
(dteEnde - dteStart, "0.00") & " Sekunden..."
End Sub

Problem jetzt: Der Code ist langsamer als vorher.
Erkennt jemand den Fehler?
Liebe Grüße
Peter

Anzeige
AW: Performance beim Kopieren steigern.
25.06.2016 14:20:29
Daniel
Hi Peter
das sind noch einige Fehler drin, du du bei ein bisschen nachdenken auch selber finden müsstest:
1. es ist nicht notwendig, die Tabellenblätter zu aktiviern.
schreibe vor jedes Cells innerhalb der Range-Funktion ebenfalls das Tabellenblatt, dann kann das aktivieren entfallen
also statt:
Beispiel1.Activate
varArr1 = Beispiel1.Range(Cells(1, 1), Cells(100, 100))

besser
varArr1 = Beispiel1.Range(.Beispiel1.Cells(1, 1), Beispiel1.Cells(100, 100))

oder noch besser
varrA1 = Beispiel1.Cells(1, 1).Resize(100, 100)
wenn du das konseqent machst, brauchst du auch kein Application.ScreenUpdating = False mehr um den Code zu beschleunigen.
2. dein Array varArr1 ist viel zu gross
du nutzt ja maximal 17 spalten, also ist es unfug, dieses 100 Spalten breit zu machen.
je mehr Werte ein Array enthält, um so länger braucht auch das Einlesen und Rückschreiben in einen Zellbereich.
mache das Array nur so gross wie benötigt, als 17 Spalten breit.
du nutzt auch nicht alle Zeilen, dh es reicht dein varArr1 auf folgende grösse festzulegen:
varArr1 = Beispiel1.Range("A1:Q" & Beispiel1.Cells(Rows.Count, 9).end(xlup).Row)
3. Wertzuweisungen, die sich innerhalb der Schleife nie verändern, solltest du nicht in der Schleife ausführen, sondern ausserhalb:
dh alle aktionen, die keinen Schleifenzähler i enthalten, können prinzipell vor der Schleife ausgeführt werden.
das kann alles vor die Schleife
                varArr2(3, 2) = varArr1(17, 1)
varArr2(4, 2) = varArr1(3, 17)
sVersion = DateValue(varArr1(4, 17))
varArr2(5, 2) = Format(sVersion, "'YYYY-MM-DD")
varArr2(6, 2) = varArr1(5, 17)
varArr2(7, 2) = varArr1(6, 17)
sTimestampMetafile = DateValue(varArr1(8, 3)) + TimeValue(varArr1(8, 3))
varArr2(8, 2) = Format(sTimestampMetafile, "YYYYMMDD_hhmmss")

4. Generell unnötiges vermeiden:
das Array varArr1 wird in dem Code nicht verändert.
daher ist es nicht notwendig, dieses ins Tabellenblatt zurückzusschreiben.
das Array varArr3 benutzt du gar nicht, also brauchst du es auch nicht einlesen.
das hier kann entfallen:
     Beispiel3.Activate
varArr3 = Beispiel3.Range(Cells(1, 1), Cells(3, 3))
                Beispiel1.Activate
Beispiel1.Range(Cells(1, 1), Cells(100, 100)) = varArr1

Gruß Daniel

Anzeige
AW: Performance beim Kopieren steigern.
27.06.2016 07:43:34
Peter
Hallo Daniel,
vielen Dank erst einmal für deine Hilfe.
Ein paar Sachen hatte ich vorher schon umgesetzt. Das mit dem "Activate" hat allerdings nochmal bisschen was an Zeit gesparrt.
Was mich allerdings immernoch verwundert: Nach dem "Umbau" auf die Array Methode ist der Code immernoch 0,1 Sekunden (0,8 Sek braucht er insgesamt) langsamer als die Methode mit der "direkten" Methode über die Tabellenblätter.
Da ich in dem Call Beispiel.Beispiel eine recht Zeweitaufwendige XML-File-Erstellung ausführe, wundert es mich nicht,dass der Code so lange braucht.
Was mich allerdings wundert ist, dass die Arraymethode länger als die Version mit der direkten Blattzuweisung braucht.
Hat da jemand eine Idee woran das liegen kann?
Beste Grüße
Peter
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige