VBA Beispiele

Auf dieser Seite möchte ich Ihnen einige schöne VBA-Beispiele vorstellen, die aus meinen Projekten oder VBA-Schulungen stammen. Das ein oder andere VBA-Beispiel findet sich selbstverständlich auch in meinem VBA-Tanker.

• Die Erstellung konsolidierter Tabellen (Excel-VBA-IV-Kurs)

Im folgenden VBA-Beispiel handelt es sich um eine Lösung, die in meinem Excel-VBA IV – Kurs behandelt wird. Es geht um das Thema der Datenverteilung. In einer Ausgangstabelle liegen 20.000 Datensätze vor, die über einen Schlüssel (Kostenstelle) auf 40 Tabellen verteilt und verdichtet werden sollen. Diese Arbeit sollten Sie auf keinen Fall händisch machen. Das händische Filtern des großen Datenbestandes wäre zwar noch eine Option, aber die Verdichtung auf Jahr/Monat wäre doch recht schwer manuell zu machen. Diese Arbeit würde in keinem Verhältnis mehr zum Ergebnis stehen. Sparen Sie viel Zeit durch den Einsatz einer Makro Lösung.

Die Ausgangssituation für dieses VBA-Beispiel sehen Sie in der nachfolgenden Abbildung.

Die Aufgabenstellung

Bei diesem VBA-Beispiel soll für jede Kostenstelle eine separate Tabelle erstellt werden. Auf den einzelnen Kostenstellenblättern werden dabei die Werte aus Spalte D pro Jahr und Monat verdichtet. Das vorliegende Datenmaterial erstreckt sich auf 24 Monate aus dem Jahr 2017/2018. Das bedeutet, dass für jede Kostenstelle genau 12 Datensätze pro Tabelle und Jahr erstellt werden müssen.

Schritte zur Lösung

1. Zunächst einmal benötigen Sie zur Umsetzung dieser Aufgabe eine Routine, die alle Kostenstellen-Tabellen aus der Arbeitsmappe entfernt. Das bedeutet, dass die Tabellen bei jedem Makro-Start neu erstellt werden.
2. Bevor die Tabellen erstellt werden, müssen Sie ermitteln, wie viele unterschiedliche Kostenstellen im Datenbestand der Tabelle tbl_Daten vorhanden sind. Sie legen nur so viele Tabellen dynamisch an, wie auch im Datenbestand enthalten sind. Dazu wird eine sogenannte Unikatsliste aller Kostenstellen in der Tabelle tbl_Unikatliste automatisch angelegt.
3. Auf Basis dieser Unikatliste aus Kostenstellen werden die neuen Kostenstellen-Tabellen automatisch generiert, nach der jeweiligen Kostenstelle benannt und die Überschrift geschrieben.
4. Im wichtigsten Schritt füllen Sie die neu erstellten Kostenstellen-Tabellen jetzt mit den dazugehörigen Daten. Die dafür am Besten geeigneter Methode ist hierbei das Zusammenspiel mit einer SQL-Anweisung, die auf die Tabelle tbl_Daten zugreift und pro Kostenstelle die Werte nach Jahr/Monat automatisch verdichtet. Im Prinzip verwenden Sie dazu eine SUMMEWENNS im Excel Jargon ausgedrückt, die um ein Vielfaches schneller, eleganter und Speicher ärmer ist.

Die Bestandteile der Lösung

Im folgenden Teil werden die einzelnen Schritte, die ich gerade beschrieben habe, umgesetzt. Dazu wird aus einem Hauptprogramm die einzelnen Unterprozeduren aufgerufen.

Sub DatenVerteilen()

Debug.Print "Start: " & Now
 
 Application.Calculation = xlCalculationManual
 Application.ScreenUpdating = False
 
 Call TabellenEntfernen
 Call UnikatslisteErstellen
 Call TabellenBefuellen
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 
 Debug.Print "Ende: " & Now
 
End Sub

Zunächst einmal wird die Startzeit des Makros festgehalten, da Sie am Ende des Makro sehen möchten, wie schnell die Aufgabe abgearbeitet worden ist. Dazu setzen Sie die Anweisung Debug.Print ein, die die aktuelle Uhrzeit in das Direktfenster der Entwicklungsumgebung schreibt. Die Berechnungsfunktion von Excel schalten Sie während des Makrolaufs über den Einsatz der Eigenschaft Calculation aus, indem Sie dieser Eigenschaft den Wert False zuweisen. Auch die Bildschirmaktualisierung wird mit Hilfe der Eigenschaft Screenupdating ausgeschaltet. Das schont zum einen die Augen und zum anderen auch Ihren Bildschirm. Beide Aktionen bringen Ihnen etwas mehr Performance und das Makro kann dadurch noch schneller ablaufen. Danach werden die einzelnen Unterprozeduren über die Anweisung Call aufgerufen. Vergessen Sie danach nicht die Berechnungsfunktion sowie die Bildschirmaktualisierung wieder einzuschalten.

Tabellen entfernen

Als erste Aufgabe wird die Prozedur TabellenEntfernen aufgerufen, die alle Kostenstellen-Tabellen in der Arbeitsmappe ohne weitere Rückfrage entfernt.

Sub TabellenEntfernen()
 Dim wksTab As Worksheet
 
 Application.DisplayAlerts = False
 For Each wksTab In ThisWorkbook.Worksheets
 If IsNumeric(wksTab.Name) = True Then
 wksTab.Delete
 End If
 Next wksTab
 Application.DisplayAlerts = True
End Sub

Zunächst einmal deklarieren Sie eine Objektvariable vom Typ Worksheet. Damit haben Sie Zugriff auf alle Methoden und Eigenschaften, die eben für eine Tabelle angeboten werden. Standardmäßig wird beim Löschen einer Tabelle eine Rückfrage angezeigt, ob die Löschung wirklich durchgeführt werden soll. Diese Rückfrage können Sie bei unserem Makro jedoch nicht gebrauchen, daher unterdrücken Sie diese, indem Sie der Eigenschaft DisplayAlerts den Wert False zuweisen.  Direkt im Anschluss daran wird eine For Each Next-Schleife aufgesetzt, die alle Tabellen der Arbeitsmappe durchläuft. Innerhalb der Schleife wird mit Hilfe der Funktion IsNumeric geprüft, ob die jeweilige Tabelle einen numerischen Namen hat. Wenn ja, dann handelt es sich um eine Kostenstelle-Tabelle, die dann über die Methode Delete entfernt werden kann.

Unikatsliste erstellen

Als nächste Prozedur wird eine Unikatsliste auf Basis der in der Tabelle tbl_Daten vorkommenden Kostenstellen erstellt. Die Liste wird  dann in der Tabelle tbl_Unikatsliste abgelegt.

Sub UnikatslisteErstellen()

tbl_Unikatsliste.UsedRange.Clear
 tbl_Daten.Range("A:A").AdvancedFilter Action:=xlFilterCopy, _
 copytoRange:=tbl_Unikatsliste.Range("A1"), unique:=True

End Sub

Es gibt einige interessante Techniken, um eine Unikatsliste zu erstellen. Persönlich am Besten gefällt mir hierbei die Technik, bei der der Spezialfilter von Excel eingesetzt wird. Zunächst einmal wird vor dem Einsatz des Spezialfilters die Tabelle über die Methode Clear geleert. Über die Eigenschaft UsedRange haben Sie Zugriff auf den aktuell verwendeten Bereich dieser Tabelle. Mit Hilfe der Methode AdvancedFilter verwenden Sie danach den Spezialfilter von Excel. Dabei geben Sie im Parameter Action bekannt, dass Sie die Spalte A in der Tabelle tbl_Daten kopieren möchten. Im Parameter CopyToRange geben Sie dabei das Ziel für die neue Liste an. Im letzten Parameter unique bestimmen Sie, dass alle Kostenstellen nur einmalig in der neuen Liste vertreten sein sollen.

Anlage und Befüllung der Tabellen

In der letzten Prozedur in diesem VBA-Beispiel werden die Tabellen auf Basis der Unikatsliste erstellt und anschließend automatisch befüllt.

Sub TabellenBefuellen()
 Dim cn As Object
 Dim rs As Object
 Dim lngZeile As Long
 Dim strFile As String
 Dim strCon As String
 Dim lngZeileMax As Long
 Dim wksZiel As Worksheet

strFile = ThisWorkbook.FullName
 strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
 & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
 
 Set cn = CreateObject("ADODB.Connection")
 Set rs = CreateObject("ADODB.Recordset")
 
 With tbl_Unikatsliste
 
 lngZeileMax = .Range("A" & .Rows.Count).End(xlUp).Row
 
 For lngZeile = 2 To lngZeileMax
 
 Set wksZiel = Worksheets.Add(after:=Worksheets(Worksheets.Count))
 wksZiel.Name = .Range("A" & lngZeile).Value
 wksZiel.Rows(1).Value = tbl_Daten.Rows(1).Value
 cn.Open strCon
 
 strSQL = "SELECT Kostenstelle, Jahr, Monat, SUM(Wert) FROM [tbl_Daten$] WHERE Kostenstelle = " & _
 .Cells(lngZeile, 1).Text & " GROUP BY Kostenstelle, Jahr, Monat"
 
 rs.Open strSQL, cn
 wksZiel.Range("A2").CopyFromRecordset rs
 cn.Close
 
 Next lngZeile
 
 End With

End Sub

Im ersten Schritt der Prozedur wird der Pfad- und Dateinamen der aktiven Arbeitsmappe über die Eigenschaft FullName ermittelt. Da der Zugriff eben auf eine Tabelle der eigenen Mappe erfolgenden soll, ist dieser Schritt notwendig. Danach wird mit Hilfe der Anweisung CreateObjekt ein ADODB-Objekt erzeugt. Dadurch gewinnen Sie Zugriff auf alle Befehle, die eben für die Abfrage großer Datenbestände (Datenbanken, Textdateien, Excel-Mappen) zur Verfügung gestellt werden. Dieses Objekt wird Ihnen dabei von Windows zur Verfügung gestellt und kann für alle Anwendungen im Office-Paket eingesetzt werden. Als nächste Teilaufgabe wird ein sogenannter Recordset erstellt. Dieser Recordset wird später die Ergebnisse unserer Abfrage aufnehmen. Über eine For Next -Schleife werden jetzt alle unikaten Kostenstelleneinträge in der Tabelle tbl_Unikatsliste abgearbeitet. Innerhalb der Schleife werden mittels der Methode Add die neuen Kostenstellen-Tabellen jeweils am Ende der Arbeitsmappe eingefügt. Über den Einsatz der Eigenschaft Name benennen Sie diese neuen Tabellen. Der Name der Tabellen beziehen Sie dabei aus der Spalte A der Tabelle tbl_Unikatsliste. Die Überschrift für die neuen Kostenstellen-Tabelle beziehen Sie direkt aus der Tabelle tbl_Daten. Dabei übertragen Sie die erste Zeile über den Einsatz der Eigenschaft Rows(1) mittels der Eigenschaft Value direkt in die jeweilige Kostenstellen-Tabelle.
Über den Einsatz der Methode Open wird die vorher erstellte Verbindung zum ADODB-Objekt hergestellt. Im Anschluss daran wird die SQL-Anweisung gebastelt. Diese lautetet:

„SELECT Kostenstelle, Jahr, Monat, SUM(Wert) FROM [tbl_Daten$] WHERE Kostenstelle = “ & _
.Cells(lngZeile, 1).Text & “ GROUP BY Kostenstelle, Jahr, Monat“

Über das SQL-Statement SELECT werden die Felder definiert, die genau in dieser Reihenfolge aus der Tabelle tbl_Daten extrahiert werden. Dabei wird die Funktion SUM eingesetzt, um die Werte zu summieren. Die Basis für die Summierung wird in der  WHERE-Klausel im Zusammenspiel mit GROUP BY angegeben.

Über die Methode Open wird nun diese SQL-Anweisung übergeben und ausgewertet. Danach stehen Ihnen alle Ergebnissätze im Recordset-Objekt zur Verfügung. Diese werden direkt danach über die Methode CopyFromRecordset in die Ziel-Kostenstellentabelle entleert. Danach kann die Verbindung über die Methode Close wieder geschlossen werden.

Zusammenfassung

Das vorliegende VBA-Beispiel benötigt für die Löschung der Kostenstellen-Tabelle und deren Neu-Anlage (40 Tabellen) mit anschließender Befüllung und Verdichtung insgesamt ca. 7 Sekunden. Dabei werden bei dieser Aufgabe 20.000 Datensätze verteilt und verdichtet.

Selbst bei guter manueller Technik und dem Wissen, wie man es denn auch manuell gebacken bekommt, ist diese Aufgabe bei Weitem nicht in dieser Zeit zu schaffen. Wenn man dann noch bedenkt, dass man diese Aufgabe mehrmals pro Monat händisch machen muss, dann kommt man sehr schnell zu dem Schluss, dass dies nicht dauerhaft zu stemmen ist.

VBA steht für die Automatisierung von Routine-Aufgaben, die dann auch gern etwas komplexer sein dürfen. Gerade lästige Aufgaben lassen sich über den Einsatz von Makros prima automatisieren. Das spart viel Zeit und auch Nerven.

Das dazu notwendige Know-How lernen Sie in meinen Excel-VBA-Kursen I-IV Schritt für Schritt kennen.

Daten in eine Monatsdarstellung importieren

Beim folgenden VBA-Beispiel aus meinem Excel-VBA-Kurs IV werden 500.000 Datensätze in eine Monatsdarstellung verdichtet. Sehen Sie dazu einmal die Ausgangssituation in der folgenden Abbildung an.

Das gewünschte Ergebnis in der Tabelle tbl_Ergebnis sieht wie folgt aus:

Für die Umsetzung dieser Aufgabe gibt es diverse Möglichkeiten. Dabei reicht die Palette vom Datenfilter, über den Einsatz einer Pivot-Tabelle bis hin zur Nutzung von SQL-Anweisungen. In diesem VBA-Beispiel wird exemplarisch die Umsetzung über den Einsatz einer SQL-Anweisung beschrieben.

Das Makro für die Umsetzung dieser Aufgabe lautet:

Sub DatenVerdichten()
 Dim cn As Object
 Dim rs As Object
 Dim strConnection As String
 Dim strSQL As String
 
 Debug.Print "Start (SQL): " & Now
 
 
 Set cn = CreateObject("ADODB.CONNECTION")

'Den Treiber bekanntgeben
 strConnection = _
 "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)}; DBQ=" & ThisWorkbook.FullName

With cn

'Datenverbindung öffnen
 .Open strConnection

'Abfragestring zusammenbasteln und Abfrage starten
 strSQL = "TRANSFORM Sum([tbl_Daten$].Umsatz) AS SummevonUmsatz SELECT " & _
 "[tbl_Daten$].Kostenstelle FROM [tbl_Daten$] GROUP BY [tbl_Daten$].Kostenstelle " & _
 "ORDER BY [tbl_Daten$].Kostenstelle PIVOT [tbl_Daten$].Monat;"

 Set rs = CreateObject("ADODB.RECORDSET")
 
 With rs
 .Source = strSQL
 .ActiveConnection = strConnection
 .Open
 tbl_Ergebnis.Range("A2:M" & tbl_Ergebnis.Rows.Count).ClearContents
 tbl_Ergebnis.Range("A2").CopyFromRecordset rs
 .Close
 End With
 End With

'ADO-Verbindung kappen
 cn.Close

 Set cn = Nothing
 Set rs = Nothing
 
 Debug.Print "Ende (SQL): " & Now

End Sub

Zu Beginn des Makros wird mit Hilfe der Methode CreateObject ein Verweis auf die Bibliothek „Microsoft ActiveX Data Objects“ gesetzt, die von Windows zur Verfügung gestellt wird. In der Variablen strConnection wird die Verbindung zur aktuellen Arbeitsmappe über die Eigenschaft FullName hergestellt. Das bedeutet, dass Sie mittels SQL auf eine Tabelle in der eigenen Arbeitsmappe zugreifen, um diese Aufgabe zu lösen. Über die Anweisung Open wird die Verbindung zunächst geöffnet. Danach wird das SQL-Kommando formuliert. Danach wird ein Recordset-Objekt erzeugt, was später das Ergebnis der SQL-Abfrage aufnehmen soll. Übergeben Sie die gerade formulierte SQL-Anweisung an die Eigenschaft Source. und übergeben Sie die aktuelle Verbindung über die Eigenschaft ActiveConnection. Über die Open-Anweisung wird das Recordset-Objekt mit dem Ergebnis der Abfrage gefüllt. Dieses steht jetzt für die weitere Verarbeitung bereit. Bevor Sie den Recordset über die Methode CopyFromRecordset in einem einzigen Aufwasch in die Zieltabelle befördern, löschen Sie den Inhalt der Zieltabelle mit Hilfe der Methode ClearContents. Kappen Sie danach die Verbindung, indem Sie die Anweisung Close einsetzen. Entfernen Sie danach die Objektvariablen aus dem Speicher, indem Sie diesen Variablen den Wert Nothing zuweisen.

Hinweis: Die Laufzeit im VBA-Beispiel zur Befüllung der Tabelle tbl_Ergebnis beträgt bei 500.000 Datensätzen, die auf insgesamt 20 Kostenstellen und 12 Monaten = 240 Zellen kumuliert werden, beträgt 4 Sekunden!

Eine noch etwas schnellere Technik (Laufzeit 1 Sekunde) lernen Sie in meinem Excel-VBA IV-Kurs kennen.

Neue Preise aus einer anderen Mappe einspielen

Beim folgendem VBA-Beispiel sollen Preise anhand einer eindeutigen Artikelnummer aus einer „fremden“ Arbeitsmappe in die eigene Arbeitsmappe importiert werden. Dies wäre für Standard-Excel-Anwender eine Aufgabenstellung, die man mit der Tabellenfunktion SVERWEIS manuell lösen könnte. Jedoch bietet diese Funktion nicht den flexiblen Einsatz, wie die im Folgenden vorgestellte Lösung über ein Makro. Sehen Sie sich vorab zur besseren Verständlichkeit einmal die nachfolgende Abbildung an.

Auf der rechten Seite der Abbildung sehen Sie unseren Bestand mit den Spalten Nr und Preis. In Spalte C sollen jetzt anhand der Nr die neuen Preise aus der Datei Preise.xlsx in Spalte C eingespielt werden. Um noch einmal auf die Tabellenfunktion SVERWEIS zu sprechen zu kommen: Der SVERWEIS kann nur zu den Artikeln neue Preise finden, die in unserem Bestand sind. Neue Artikel kann diese Funktion nicht automatisch hinzufügen. Unser Makro kann das aber schon, und zwar ohne Probleme. Die neuen Artikel werden sogar dabei automatisch gekennzeichnet. Des Weiteren kann der SVERWEIS immer nur Daten finden, die rechts vom Suchbegriff angeordnet sind. Gut, dass ist bei dieser Aufgabe keine Hürde, aber praktisch kann unser Makro Daten völlig dynamisch abgreifen. Das Makro für den automatischen Import der neuen Preise und Artikel sieht dabei wie folgt aus:

Sub PreiseAktualiseren()
 'Neue Preise befinden sich in der Mappe Preise.xlsx
 Dim lngZeile As Long
 Dim lngZeileMax As Long
 Dim lngZeileFrei As Long
 Dim rngTreffer As Range
 Dim wkbQuelle As Workbook

Application.ScreenUpdating = False
 Set wkbQuelle = Workbooks.Open(ThisWorkbook.Path & "\Preise.xlsx")

With wkbQuelle.Worksheets(1)
 lngZeileMax = .Range("A" & .Rows.Count).End(xlUp).Row

For lngZeile = 2 To lngZeileMax

Set rngTreffer = tbl_Bestand.Range("A:A").Find _
 (what:=.Range("A" & lngZeile).Value, lookat:=xlWhole)

If rngTreffer Is Nothing Then
 'Neuanlage
 lngZeileFrei = tbl_Bestand.Range("A" & tbl_Bestand.Rows.Count).End(xlUp).Row + 1
 tbl_Bestand.Range("A" & lngZeileFrei).Value = .Range("A" & lngZeile).Value
 tbl_Bestand.Range("C" & lngZeileFrei).Value = .Range("B" & lngZeile).Value
 tbl_Bestand.Range("A" & lngZeileFrei).Interior.ColorIndex = 6
 Else
 'update
 rngTreffer.Offset(0, 2).Value = .Range("B" & lngZeile).Value

End If

Next lngZeile
 tbl_Bestand.Range("A:C").Sort key1:=tbl_Bestand.Range("A1"), order1:=xlAscending, Header:=xlYes
 wkbQuelle.Close
 End With
 Application.ScreenUpdating = True
 End Sub

Zunächst einmal wird die Bildschirmaktualisierung über die Eigenschaft Screenupdating ausgeschaltet. Damit läuft das Makro erheblich schneller, der Bildschirm sowie die Augen werden geschont und der Anwender merkt nicht, dass die Daten aus einer anderen Arbeitsmappe eingelesen werden. Der Bildschirm bleibt während der ganzen Zeit „eingefroren“.  Im nächsten Schritt wird die Datei Preise.xlsx mit Hilfe der Methode Open  geöffnet und der Objektvariablen wkbQuelle zugewiesen. Dies hat genau zwei Vorteile: Zum einen können Sie diese Datei dann über die Objektvariable ansprechen und zum Anderen hilft Ihnen die Entwicklungsumgebung von Excel über den sogenannten Intellisense beim Editieren des Makros weiter – es werden nur Befehle in einem Dropdown angeboten, die eben für das Objekt Workbook verfügbar sind.
Nachdem die Datei geöffnet vorliegt, wird auf die erste Tabelle in dieser Mappe referenziert. Danach wird ermittelt, wie viele Zeilen in der Tabelle vorhanden sind. In einer anschließenden Schleife werden genau diese Anzahl der verfügbaren Zeilen eingelesen. In der Schleife selbst wird mit Hilfe der Methode Find die entsprechende Zeile in unserem Bestand gesucht. Der Suchbegriff wird dabei im Parameter What angegeben. Im Parameter LookAt, der die Konstante xlWhole zugewiesen wird, bestimmen Sie, dass die Suche wirklich nur 1:1 stattfinden soll. Das bedeutet, dass die Suche hunderprozentig immer nur nach der Nr sucht, die im Suchbegriff unter What angegeben wurde. Fehlt dieser Parameter, dann würde beispielsweise die Nummer 100 gefunden werden, wenn Sie als Suchbegriff die 10 angegeben haben. Nachdem die Suche gestartet ist, gibt es zwei mögliche Ergebnisse: Der Artikel wird gefunden, dann sprechen wir von einem UPDATE oder der Artikel wurde nicht gefunden, dann handelt es sich um eine NEUANLAGE des Artikels. Neu angelegte Artikel werden zunächst unten in der Liste angehängt, eingefärbt und am Ende des Makro über die Methode SORT in die richtige Reihenfolge gebracht.

Zusammenfassung

Gerade bei größeren Datenbeständen, die regelmäßig eingelesen werden müssen, bietet diese Lösung größtmögliche Flexibilität und eine sehr schnelle Verarbeitungsgeschwindigkeit.
Dieses VBA-Beispiel wird am 3. Tag meines Excel-VBA-I-Kurses behandelt. In diesem Kurs lernen Sie die wichtigsten Befehle (ca. 50 Stück) sowie den Gebrauch von Schleifen, Bedingungen usw. anhand praxisnaher Beispiele kennen.

Verdichtung von Buchungen

Beim folgenden VBA-Beispiel liegt eine Tabelle mit Massendaten wie in der nächsten Abbildung gezeigt, vor:

In einer Tabelle mit drei Spalten sollen die Werte auf Basis der Kostenstelle und des Monats in einer Matrix verdichtet werden. Das dazu notwendige Makro sieht dabei wie folgt aus:

Sub DatenInMatrixEinfuegenV2()
Dim lngZeile As Long
Dim lngZeileMax As Long
Dim VarDat As Variant
Dim VarDatZiel As Variant
Dim lngZ As Long
Dim lngZMax As Long
Dim lngSp As Long

Debug.Print "Start V2: " & Now

Application.ScreenUpdating = False
lngZMax = tbl_Matrix.UsedRange.Rows.Count

With tbl_Daten
VarDat = .UsedRange
VarDatZiel = tbl_Matrix.Range("A2:M" & lngZMax)

lngZeileMax = UBound(VarDat)

For lngZeile = 2 To lngZeileMax
lngSp = Month(VarDat(lngZeile, 1)) + 1

For lngZ = 1 To UBound(VarDatZiel)
If VarDat(lngZeile, 2) = VarDatZiel(lngZ, 1) Then
VarDatZiel(lngZ, lngSp) = VarDatZiel(lngZ, lngSp) + VarDat(lngZeile, 3)
Exit For
End If
Next lngZ

Next lngZeile

End With

With tbl_Matrix
.Range("A2:M" & lngZMax).Value = VarDatZiel
End With

Application.ScreenUpdating = True
Debug.Print "Ende V2: " & Now

End Sub

Bei der Umsetzung von diesem VBA-Beispiel werden die Daten aus der Tabelle tbl_Daten in den Arbeitsspeicher in einen Array befördert. Auch die Zieltabelle wird in den Arbeitsspeicher gebracht, sodass die Füllung der Daten direkt im Arbeitsspeicher stattfinden kann. Über eine Schleife wird Zeile für Zeile des Arrays Vardat durchlaufen. Innerhalb der Schleife wird in einer weiteren Schleife der Kostenstellenabgleich vorgenommen. Das bedeutet: In der zweiten Spalte des Arrays VarDat befinden sich die Kostenstellen – im Ziel Array VarDatZiel befinden sich die Kostenstellen in der ersten Spalte. Sie können dies schön im Lokal-Fenster der Entwicklungsumgebung verfolgen, wenn Sie das Makro Schrittweise mit der Taste F8 durchgehen. Wird eine Übereinstimmung gefunden, dann wird die Schleife über die Anweisung Exit For verlassen. Damit ist die Zielzeile im Array VarDatZiel bestimmt. Die Zielspalte ermitteln Sie, indem Sie den Monat aus dem jeweiligen Datum extrahieren und auf diesen Wert den Wert 1 aufaddieren. Z.B. 12.05.2017 = 5+1 = 6. Spalte im Array VarDatZiel. Somit haben Sie sowohl die Zeile als auch die Spalte im Ziel-Array VarDatZiel ermittelt und können dann die jeweiligen Werte aus der dritten Spalte des Array VarDat kumulieren.

Am Ende der beiden Schleifen muss der Array VarDatZiel in die Zieltabelle befördert werden. Dies können Sie einfach machen, indem Sie dem Zielbereich über die Eigenschaft Value den kompletten Array ausleeren.

Die Laufzeit bei diesem VBA-Beispiel mit über 100.000 Datensätzen beträgt weniger als 1 Sekunde.

Test