VBA - Code optimieren

[Kirschgurke]

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

[Fennek]

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

[chris-ka]

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

siehe Demo.
 
  umbauen.xlsm (Größe: 43,77 KB / Downloads: 2)
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

[Kirschgurke]

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

[Matthias84]

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]

[snb]

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