Dieser Excel-VBA-Tipp richtet sich an Anwender/Entwickler, die bereits fortgeschrittene Kenntnisse in der Programmierung unter VBA besitzen.
Häufig tritt der Fall auf, dass Datensätze unbekannter Anzahl erzeugt bzw. eingelesen,
weiterverarbeitet und aufgelistet werden müssen. Für die unterschiedlichen Daten existieren jedoch auch gleichzeitig unterschiedliche Formate wie Text, Datum, Prozent, Währung usw.
Nun gibt es mehrere Möglichkeiten diese Vorformatierungen auf den Zielbereich – also den
Bereich in den schließlich die Daten geschrieben werden zu übertragen. Ein Beispiel dafür ist im folgenden Code-Schnipsel dargestellt.
In diesem existiert ein Zielbereich, der bereits Daten enthalten kann. In einer
Template-Zeile, die der Named Range „rngTemplate“ zugeordnet ist sind alle relevanten Formatierungen für die einzelnen Spaltenwerte eingestellt. Gegebenfalls können hier auch Formelbezüge
enthalten sein. Aus dieser Zeile wird die Formatierung kopiert und in den Zielbereich eingefügt.
Um die Template-Zeile zu erstellen, wird beispielsweise die zweite Zeile des Arbeitsblattes
entsprechend formatiert und die gesamte Zeile mit der Named Range „rngTemplate“ benannt. Damit die Zeile den Anwender optisch nicht stört sollte diese ausgeblendet werden.
Dim rngTarget As Range
With wksSheet
Set rngTarget = .Range(.Cells(.Range("rngSpalte1").Row + 1, .Range("rngSpalte1").Column), .Cells(.Range("rngLetzteZeile").Row + 1, .Range("rngLetzteSpalte").Column))
End With
wksSheet.Rows(wksSheet.Range("rngTemplate”).Row).Copy
Call wksSheet.Rows(rngTarget.Row & ":" & rngTarget.Row + rngTarget.Rows.Count - 1).PasteSpecial(xlPasteFormats)
Die Named Ranges “rngSpalte1”, “rngLetzteSpalte” und “rngLetzteZeile” definieren hierbei den Datenbereich (siehe unten).
Auch wenn obiger Code das gewünschte Resultat liefert, existieren hier zwei entscheidende Nachteile:
1. Je nach Anzahl der Datensätze kann das obige Vorgehen viel Rechenzeit beanspruchen, was zu langen Wartezeiten führen kann.
2. Der weitaus größere Nachteil ist, dass der Datenbereich ist nicht dynamisch ist. Die letzte befüllte Zeile des Datenbereichs müsste erneut gesetzt werden um bei späterem Hinzufügen weiterer Daten nicht die alten zu überschreiben.
Betrachten wir zunächst nur den zweiten Punkt. Wir haben, wie oben erkennbar, die Named Range „rngSpalte1“. Diese entspricht der oberen linken Kopfzeile des Datenbereichs und enthält z.B. die Spaltenbezeichnung (in der Abbildung entspricht dies Zelle B3). Für die letzte Spalte des Bereichs markiert die Named Range „rngLetzteSpalte“ die entsprechende obere rechte Zelle (Zelle E3 in der Abbildung).
Die dritte Named Range liegt auf der ersten Zeile unterhalb des letzten befüllten Datensatzes (bei einem leeren Datenbereich zunächst direkt unterhalb der Kopfzeile).
Anmerkung: Die Bezeichnungen der Named Ranges sind nur exemplarisch. Im Rahmen der professionellen Entwicklung sollten hier klare Bezeichnungen gewählt werden, die z.B. die Benennung des Attributs des Datensatzes enthalten (wie z.B. "rngName").
Um den Datenbereich dynamisch zu vergrößern bietet es
sich nun an, nicht bloß die Formatierung der Templatezeile zu kopieren, sondern die komplette Zeile.Mit dem folgenden Code lässt sich eine beliebige Zahl an Templatezeilen einfügen (die Anzahl
wird durch die Variable „lngRows“ vorgegeben.
Dim lngRows As Long
Dim lngI As Long
Application.ScreenUpdating = False
lngRows = 10
wksSheet.Rows(wksSheet.Range("rngTemplate”).Row).EntireRow.Hidden = False
wksSheet.Rows(wksSheet.Range("rngTemplate”).Row).Copy
For lngI = 1 To lngRows
Call wksSheet.Rows(wksSheet.Range("rngLetzteZeile”).Row).Insert(xlDown)
Next lngI
wksSheet.Rows(wksSheet.Range("rngTemplate”).Row).EntireRow.Hidden = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
Da wir die Templatezeile ausgeblendet hatten, muss diese zunächst über die Eigenschaft „Hidden = False“ eingeblendet werden. Nach Abschluss des Kopiervorgangs wird sie schließlich wieder ausgeblendet.
Die Eigenschaft „Application.ScreenUpdating = False“ sorgt dafür, die der Anwender die einzelnen Kopiervorgänge nicht sehen kann, was zum Einen gut für die Performance ist und den Prozess zusätzlich optisch stabilisiert.
Um die gestrichelte Kopierlinie der Templatezeile nicht mehr zu sehen wird zusätzlich die Eigenschaft „Application.CutCopyMode = False“ gesetzt.
Bei dem oben gezeigten Vorgehen verschiebt sich die letzte Zeile mit der Named Range „rngLetzteZeile“ immer weiter nach unten, was zu Folge hat, dass neue Datensätze grundsätzlich unten angefügt werden und der Datenbereich somit dynamisch bleibt.
Dennoch hat diese Methode den Nachteil, dass sie sehr imperformant ist. Bei einer geringen Zahl von Datensätzen fällt dies nicht so stark ins Gewicht. Doch bei eine Anzahl von z.B. 1.000 oder gar 10.000 neuer Datensätze verursacht das Einfügen der Zeilen in jedem Schleifendurchlauf, eine enorme Auslastung und somit Geschwindigkeitsverlust.
Abhilfe schafft hier eine Vergrößerung des Zielbereichs über die Methode „Resize“. Damit ließe sich obiger Code folgendermaßen anpassen:
Dim lngRows As Long
Application.ScreenUpdating = False
lngRows = 10000
wksSheet.Rows(wksSheet.Range("rngTemplate”).Row).EntireRow.Hidden = False
wksSheet.Rows(wksSheet.Range("rngTemplate”).Row).Copy
Call wksSheet.Rows(wksSheet.Range("rngLetzteZeile”).Row).Resize(lngRows).Insert(xlDown)
wksSheet.Rows(wksSheet.Range("rngTemplate”).Row).EntireRow.Hidden = True
Application.CutCopyMode = False
Application.ScreenUpdating = True
Dies ist zum Einen deutlich kompakter, als auch deutlich schneller, was für die meisten VBA-Projekte äußerst wichtig ist.
Als nächstes stellt sich die Frage, wie der nun zur Verfügung stehende Datenbereich möglichst performance-optimiert mit Daten befüllt werden kann.
Diesem Thema widme ich mich im nächsten Beitrag.
Kommentar schreiben
Lloyd Volk (Sonntag, 05 Februar 2017 06:49)
Please let me know if you're looking for a writer for your site. You have some really great articles and I believe I would be a good asset. If you ever want to take some of the load off, I'd absolutely love to write some material for your blog in exchange for a link back to mine. Please shoot me an email if interested. Thank you!