AW: Makro Beschleunigen
29.11.2016 09:39:54
Daniel
Hi
wenn man mehrere Zellen übertragen will, die einen lückenlosen rechteckigen Block bilden, dann kann man diesen Zellblock in einem Programmschritt als ganzes übertragen und muss nicht jede Zelle einzeln übernehmen. Das geht dann schneller, weil Excel dann die Aktionen, die es beim Einfügen von Werten in ein Tabllenblatt ausführen muss, nicht für jede Zelle einzeln ausführen muss, sondern nur für jeweils diesen Block:
Ersetze also:
.Cells(lRe, Anz) = wksD.Cells(Z, 2).Value
.Cells(lRe, Anz + 1) = wksD.Cells(Z, 3).Value
.Cells(lRe, Anz + 2) = wksD.Cells(Z, 4).Value
.Cells(lRe, Anz + 3) = wksD.Cells(Z, 5).Value
.Cells(lRe, Anz + 4) = wksD.Cells(Z, 6).Value
.Cells(lRe, Anz + 5) = wksD.Cells(Z, 7).Value
durch
.Cells(leRe, Anz).Resize(1, 6).Value = wksD.Cells(z, 2).Resize(1, 6).Value
ansonsten enthält dein Code noch überflüssige Schleifen:
dashier ist unnötig
For ii = 17 To loEnde
If .Cells(ii, 2) "" Then
AngAnzahl = AngAnzahl + 1
End If
Next ii
du kannst das AngAnzahl = AngAnzahl + 1 auch in die Schleife zum kopieren der Werte durchführen (hat den gleichen Schleifenzähler und die gleiche IF-Bedingung)
dann muss diese Schleife nur 1x laufen und nicht 2x
auch diese Schleife ist unnötig:
For ii = 17 To .Cells(Rows.Count, 6).End(xlUp).Row
If .Cells(ii, 6) = "Gesamt netto" Then
loEnde = ii - 1
Exit For
End If
Next ii
da kannst du auch programmieren:
LoEnde = .Columns(6).Find(what:="Gesamt netto").Row - 1
für deine Beispieldatei wäre die wahrscheinlich beste lösung:
LoEnde = .Cells(.Rows.count, 5).End(xlup).Row
Gruß Daniel