Clever-Excel-Forum

Hallo zusammen,

ich hoffe Ihr könnt mir weiterhelfen. Ich benutze folgenden Code um mehrere spalten (365) abzufragen und hier dann einige Zeilenergebnisse untereiannder zu kopieren. Es funktioniert auch genauso wie es soll. Es ist aber verdammt langsam. Seht Ihr vielleicht eine Möglichkeit den Vorgang zu optimieren? Dauert aktuell bestimmt 5min und muss ich dann sogar aktiv beenden.

Sub Spaltenuntereianderkopieren()

Dim QZeile As Long 'Zeile Quelle
Dim QSpalte As Long 'Spalte Quelle
Dim ZZeile As Long 'Zeile Ziel

ZZeile = 2 'Startzeile in der Zielspalte

For QSpalte = 6 To 366 'Spalte D bis H

For QZeile = 4 To 11

Tabelle1.Cells(ZZeile, 1) = Tabelle1.Cells(QZeile, QSpalte) 'die 9 ist Spalte I
ZZeile = ZZeile + 1

Next

Next

End Sub

vg

Hallo,

versuche es mal so:

Code:
for Sp = 6 to 366

    range(cells(4,SP),cells(11, Sp)).copy cells(rows.count,1).end(xlup).offset(1)

next Sp

Wie lange dauert es so?

mfg

Hi,
da liegt die Gurke nicht begraben.
Obwohl ein Array sicherlich schneller gehen würde, bzw. wäre Powerquery auch ein Thema.

siehe Demo.
[attachment=18737]
Dauer 0,x Sek.

Mit deinem Originalcode.

Sind bei Dir Formeln im Einsatz und/oder bedingte Formatierungen....

Edit: hier mal eine "hardcodierte" Arraylösung.

Code:
Sub marine()

Dim arr As Variant, i As Long, y  As Long, arrA(1 To 2888)

With Tabelle1

arr = .Range("F4:NB11")

    For y = 1 To 361

        For i = 1 To 8

            za = za + 1

            arrA(za) = arr(i, y)

        Next

    Next

    .Range("A2:A2888").Value = WorksheetFunction.Transpose(arrA)

End With

End Sub

Wow! Dauer jetzt 1sec :) Kannst du mir grob erklären woran der starke Unterschied liegt? vg

Hallo,

bei deinem originären Code schreibt Excel jede Zelle einzeln und das Beschriften von Zellen dauert bei Excel ewig... Bei den Lösungsvorschlägen der anderen Forum-Teilnehmer wird nur einmal in deine Excel-Datei geschrieben.

Weitere allgemeine Hinweise zur Code-Optimierung findest du in [url=
Dateiupload bitte im Forum! So geht es: Klick mich!
15[/url]

Code:
sn=Tabelle1.Range("F4:NB11")

redim sp(ubound(sn)*ubound(sn,2),0)

for each it in sn

  sp(y,0)=it

  y=y+1

next

Tabelle1.cells(1).resize(ubound(sp))=sp

Kirschgurke

Fennek

chris-ka

Kirschgurke

Matthias84

snb