2018 – April (VBA)

Im April-VBA-Kracher Rundschreiben werden die folgenden Themen behandelt:

  • Maximale Flexibilität: Eine allgemein gültige Formel über R1C1-Schreibweise erstellen
  • Massendatenverarbeitung: Daten verdichten über das Dictionary-Objekt
  • Geschwindigkeit plus: Werte in einem bestimmten Datumsbereich über SQL abfragen
  • Etwas Spielerisches: Walzenbingo mit Excel
  • Blitzschnell: Access-Daten anzapfen und in Excel-Pivot-Tabelle ausgeben

Maximale Flexibilität: Eine allgemein gültige Formel über R1C1-Schreibweise erstellen

Die Aufgabenstellung lautet: Bilde eine Summe unterhalb eines Datenblocks.
Nun, das klingt zunächst einmal relativ überschaubar, was den Schwierigkeitsgrad angeht. Sehen Sie sich dazu einmal die Ausgangssituation in der folgenden Abbildung an.

 

 

 

 

 

 

 

 

 

 

 

 

 

Im Bereich A1:L15 liegen Monatsdaten vor, bei denen pro Monat eine Summe unterhalb der Tabelle eingefügt werden soll. Diese Summe soll über eine Formel eingespeist werden, dabei soll es sich um eine R1C1-Formeln handeln. Wie das genau geht, sehen Sie im folgenden Listing.

Sub SummeSchreibenR1C1()

  Tabelle1.Range("A20:L20").FormulaR1C1 = "=SUM(R[-1]C:R[-18]C)"

End Sub

'*** Quelle: VBA-Tanker: ID 9480 ***

Mit Hilfe der Eigenschaft FormulaR1C1 kann eine Formel in der R1C1-Schreibweise erfasst werden. Diese Technik erlaubt es, eine Formel relativ dynamisch und für alle Zellen im Zielbereich identisch einzufügen. Über die Funktion SUM wird die Tabellenfunktion SUMME eingefügt. Der Teil R[-1]C bedeutet, dass der Formelbezug für sie Summe eine Zeile oberhalb der Ergebniszelle in der gleichen Spalte beginnt. Der Teile R[-18]C verweist auf den Beginn der Summierung, die 18 Zeilen oberhalb der Ergebniszelle, ebenso in der gleichen Spalte liegt. Die Übersetzung der R1C1-Schreibweise erfolgt automatisch beim Ablauf des Makros (siehe folgende Abbildung Zeile 20)

 

 

 

Massendatenverarbeitung: Daten verdichten über das Dictionary-Objekt

Beim folgenden Beispiel aus meinem VBA-Tanker wird das Dictionary-Objekt behandelt. Über dieses Objekt, das von Windows bereitgestellt wird, können Sie unter anderem Daten verdichten, Unikate ermitteln und vieles mehr. In diesem Beispiel sollen Werte summiert werden, die einer bestimmten Nummer zugeordnet sind. Schauen Sie sich dazu einmal vorab die folgende Abbildung an.

 

 

 

 

 

 

 

 

 

 

 

 

 

 

In den Spalten D sollen die unikaten Nummern aus Spalte A eingefügt werden. In Spalte E sollen die dazugehörigen summen gebildet werden. Eine mögliche Art der Umsetzung dieser Aufgabe wäre der Einsatz des Objekts Dictionary. Sehen Sie sich dazu das folgende Makro an.

Sub WerteZusammenfassen()
  Dim objDic As Object
  Dim rngZelle As Range
  Dim vntKeys As Variant
  Dim vntItems As Variant 

  Set objDic = CreateObject("Scripting.Dictionary")

  With Tabelle1
   .Range("D:E").Clear
   Each rngZelle In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
    If Not objDic.exists(rngZelle.Value) Then
        objDic.Add rngZelle.Value, rngZelle.Offset(0, 1).Value
    Else
        objDic(rngZelle.Value) = objDic(rngZelle.Value) + rngZelle.Offset(0, 1).Value
    End If

    Next rngZelle
    vntKeys = objDic.keys
    vntItems = objDic.items
    .Cells(1, 4).Resize(UBound(vntKeys) + 1) = WorksheetFunction.Transpose(vntKeys)
    .Cells(1, 5).Resize(UBound(vntItems) + 1) = WorksheetFunction.Transpose(vntItems)
    .Range("D:E").Sort key1:=.Range("D1"), order1:=xlAscending, Header:=xlNo
  End With 

End Sub

'*** Quelle: VBA-Tanker: ID 9490 ***

Zunächst einmal wird das Objekt Dictionary über die Anweisung CreateObject erstellt. Danach haben Sie Zugriff auf alle Methoden und Eigenschaften, welches dieses Objekt Ihnen zur Verfügung stellt. Die Zielspalten D und E werden danach über die Methode Clear geleert. Anschließend wird eine For each – Schleife aufgesetzt, um alle verwendeten Zelle der Spalte A abzuarbeiten. Innerhalb dieser Schleife wird über die Funktion Exists abgefragt, ob die jeweilige Nummer aus Spalte A sich bereits im Dictionary Objekt befindet. Wenn nicht, dann wird mit Hilfe der Methode Add diese Nummer im Dictionary-Objekt angelegt. Im ersten Parameter (keys) wird dabei die Nummer hinterlegt, im zweiten Parameter (items)  wird der dazugehörige Wert aus Spalte B hinzugefügt. Befindet sich die Nummer bereits im Dictionary-Objekt, dann muss lediglich der Wert kumuliert werden.

Am Ende der Schleife werden die Inhalte des Dictionary-Objekt in zwei Arrays gepackt. Diese können dann elegant im Lokal-Fenster betrachtet werden. Setzen Sie dazu einen Haltepunkt (Taste F9) an die in der folgenden Abbildung gezeigten Stelle und lassen das Makro bis an diese Stelle (Taste F5) laufen. Blenden Sie danach das Lokal-Fenster ein und klappen die beiden Arrays auf.

Entleeren Sie beide Arrays in den Zielbereich der Spalten D und E. Dazu muss der dafür benötigte Platz in der Tabelle „vorreserviert“ werden. Über die Methode Resize wird der Bereich auf Basis des letzten Eintrags im Array beginnend in der Zelle D1 / E1 vergrößert. Mit Hilfe der Worksheetfunction Transpose wird der Array gedreht und im Zielbereich ausgegeben. Im Anschluss daran wir die Methode Sort angewendet, um den Bereich nach der Nummer aufsteigend zu sortieren.

Geschwindigkeit plus: Werte in einem bestimmten Datumsbereich über SQL abfragen

Bei der nachfolgenden Lösung sollen Massendaten flexibel abgefragt und das Ergebnis auf einer anderen Tabelle ausgegeben werden. Beim vorliegenden Beispiel liegen nur wenige Daten vor, damit das Ergebnis besser nachvollzogen werden kann. Sehen Sie sich einmal die Ausgangssituation in der folgenden Abbildung an.

 

 

 

 

 

 

 

 

 

 

 

In den Zellen G1 und H1 werden Datumsangaben erfasst. Alle Daten, die in Spalte A in diesem vorgegebenen Datumsbereich liegen sollen in Tabelle2 ausgegeben werden.

Zur Umsetzung dieser Aufgabe wird eine SQL-Anweisung in Verbindung mit der Zugriffsbibliothek ADO eingesetzt.

Sub SQLAbfrageExcelTabelleMitBedingungDatum()
  Dim cn As ADODB.Connection
  Dim rs As ADODB.Recordset
  Dim lngZeile As Long
  Dim strFile As String
  Dim strCon As String
  Dim strTab As String

  
  Tabelle2.UsedRange.Clear
  lngZeile = 1

  strFile = ThisWorkbook.FullName
  strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _

  & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"  

  strTab = tbl_Daten.Name
  Set cn = CreateObject("ADODB.Connection")
  Set rs = CreateObject("ADODB.Recordset")
  cn.Open strCon
  strSQL = "SELECT * FROM [" & strTab & "$A1:C10] WHERE Datum BETWEEN " & Format(tbl_Daten.Cells(1, 7).Value, "\#yyyy\-mm\-dd\#") & _
   " And " & Format(tbl_Daten.Cells(1, 8).Value, "\#yyyy\-mm\-dd\#")
  rs.Open strSQL, cn
  Tabelle2.Range("A1").CopyFromRecordset rs
  Tabelle2.Range("A:A").NumberFormat = "DD.MM.YYYY"

End Sub

Zunächst einmal muss im Vorfeld die Bibliothek „Microsoft ActiveX Data Objects 6.1 Library“ in der Entwicklungsumgebung unter Extras/Verweis eingebunden werden. Danach wird die Zieltabelle über die Methode Clear geleert. Damit die SQL-Anweisung im späteren Verlauf des Makros auch auf die aktuelle Mappe zugreift, fragen Sie den aktuellen Pfad- und Dateinamen mittels der Eigenschaft FullName ab und speichern diesen in der String-Variablen strFile. Den Namen der Quell-Tabelle speichern Sie direkt in der Variablen strTab. Erstellen Sie jetzt über die Anweisung CreateObject ein ADO-Objekt, um Zugriff auf alle benötigten Befehle zu bekommen, um die Abfrage erstellen zu können. Über die Anweisung Open wird das ADO-Objekt geöffnet. Danach wird die Abfrage dynamisch formuliert, wobei auf die Quelle und Zieltabelle sowie auf die beiden Datumszellen zugegriffen wird. Hierbei sei angemerkt, dass ein Datumsformat bei ADO über die Funktion Format in das hier gezeigte Format gebracht werden muss. Über die Anweisung Open wird das Recordset-Objekt erstellt, indem der gerade gebastelt SQL-String übergeben und angewendet wird. Danach stehen die Ergebnisse direkt im Recordset-Objekt rs. Alles was jetzt noch passieren muss, ist die Entleerung dieses Objekts in die Zieltabelle. Dazu wird die Methode CopyFromRecordset eingesetzt. Da die Formatierung des Datums dabei interessanter Weise verloren geht, weisen Sie der Spalte A über die Eigenschaft NumberFormat das Datumsformat wieder zu.

Etwas Spielerisches: Walzenbingo mit Excel

Bei der folgenden Lösung möchte ich Ihnen eine Lösung vorstellen, die ich auch auf Grund einer Anfrage aus Polen spaßeshalber umgesetzt habe. Dabei ging es um ein sogenanntes „Walzen-Bingo“. Was das genau ist, war mir bis zu diesem Zeitpunkt auch noch nicht bekannt. Man kennt sowas in der Art aber aus Spielsalons „Einarmige Banditen“…

In der Tabelle tbl_Start habe ich zu diesem Zweck 3 Picture-Steuerelemente eingefügt. Auf der Tabelle tbl_Bilder habe ich insgesamt 12 Steuerelemente vom gleichen Typ eingefügt und manuell einmal mit Bildern bestückt, die mir vorlagen. Danach sollen jeweils aus diesen 12 Bildern 3 zufällig gewählt werden und in der Tabelle tbl_start eingefügt werden. Um den Effekt zu erzielen, dass die Walzenräder „laufen“ habe ich eine Schleife darum gepackt.

Exemplarisch zeige ich Ihnen den Aufruf der Hauptprozedur, welches alle drei Walzen nacheinander dreht.

Sub Aufruf()
  Dim i As Integer

  For i = 1 To 10
    WalzenBingoStarten1
   DoEvents
    Pause 0.02
    WalzenBingoStarten2
  DoEvents
    Pause 0.1
    WalzenBingoStarten3
  DoEvents
    Pause 0.1
    If tbl_Start.Range("E19").Value = tbl_Start.Range("I19").Value And _
     tbl_Start.Range("E19").Value = tbl_Start.Range("M19").Value Then
     MsgBox "Gewinn!"
     Exit Sub
  End If
  Next i

End Sub

In einer Schleife, die genau 10 Mal läuft werden nacheinander immer drei neue Bilder eingefügt. Die nummern der Bilder habe ich hierfür in den Zellen E19, I19 und M19 hinterlegt. Werden drei Bilder gezogen, die identisch sind, dann hat der Spieler gewonnen.

Um beispielsweise das erste Walzenrad zu füllen, wird das Makro WalzenbingoStarten1 aufgerufen.

Sub WalzenBingoStarten1()
Dim intzufall As Integer

 intzufall = Int(11) * Rnd + 1
 tbl_Start.imgWalze1.Picture = tbl_Bilder.OLEObjects("Image" & intzufall).Object.Picture
 tbl_Start.Range("E19").Value = intzufall

End Sub

In dieser Prozedur wird eine Zufallszahl über die Funktion Rnd im Wertebereich zwischen 1 und 12 ermittelt. Über die Eigenschaft Picture wird der ersten Walze das Bild zugewiesen, dass aus der Tabelle tbl_Bilder aus dieser Zufallszahl ermittelt wird. Dabei wird der Name des Bildes mit der Prefix Image verschmolzen.

Blitzschnell: Access-Daten anzapfen und in Excel-Pivot-Tabelle ausgeben

Bei der letzten Lösung soll eine Access-Datenbank von Excel angezapft werden und in einer Pivot-Tabelle ausgegeben werden. Diese Lösung ist unter anderem ein Thema in meinem Excel-VBA IV-Kurs.

Sub DatenbankTabelleOeffnenAlsPivotTabelleLösung()
  Dim wkbZiel As Workbook
  Dim wksTab As Worksheet
  Dim objPiv As PivotTable

  If Dir(ThisWorkbook.Path & "\Nordwind.accdb") <> "" Then
  Set wkbZiel = Workbooks.OpenDatabase(Filename:=ThisWorkbook.Path & "\Nordwind.accdb", _
   CommandText:="Bestellungen", CommandType:=xlCmdTable, _
   BackgroundQuery:=True, ImportDataAs:=xlPivotTableReport)
  End If
  Set wksTab = wkbZiel.Worksheets(1)
  Set objPiv = wksTab.PivotTables(1)
  With objPiv
    .AddFields RowFields:="Bestimmungsland"
    .AddFields ColumnFields:="Ort"
    .PivotFields("Frachtkosten").Orientation = xlDataField
 'oder:
'    .PivotFields("Bestimmungsland").Orientation = xlRowField
'    .PivotFields("Ort").Orientation = xlColumnField
'    .PivotFields("Frachtkosten").Orientation = xlDataField
  End With

End Sub

Zunächst einmal wird mittels der Funktion Dir geprüft, ob die Datenbank existiert. Wenn ja, dann wenden Sie die Methode OpenDatabase an, um die Datenbank zu öffnen. In dieser Datenbank gibt es eine Abfrage mit dem Namen Bestellungen. Diese Abfrage wird ausgeführt und über den Parameter ImportDataAs und der Konstanten xlPivotTableReport an Excel im Pivot-Tabellenformat übergeben. Danach muss die Pivot-Tabelle noch näher spezifiziert werden. Über die Methode AddFields wird exemplarisch ein Zeilenfeld definiert. Die Orte sollen horizontal ausgegeben werden. Daher verwenden Sie den Parameter ColumnField. Dem Datenfeld wird die zu berechnende Information, die Frachtkosten zugewiesen.