Datenverarbeitung in Excel mittels SQL.
Download lib_adodb_for_xls.bas (V-1.6.0)
Excel ist nett, aber auch unübersichtlich. Vor allem wenn man mit Datenmengen und VBA arbeiten will. Um Daten anzureichern, in grösseren Mengen zu verarbeiten etc. sehe ich immer wieder Script die Zellenadressen zusammensetzen und dadurch unlesbar sind. Wer weiss beim lesen schon, was die A4 ist?
Nungut, ich komme von der Datenbankseite. Dort arbeite ich mit SQL um die Datan abzufragen, zusammenzusetzen etc.. Zum Glück für mich, ist das alles auch in Excel VBA möglich.
ADODB hiesst das Losungswort.
Ich erkläre hier nicht alle Details. Das WWW gibt gut auskunft. Nein, ich zeige wie ich es anwende
Den Code zu den Funktionen gibts am Schluss
Sammlung von steuerparametern. Es werden, ev. in Zukunft noch mehr.
Public Enum axConnParams axcNone = 0 axcReconnect = 2 ^ 0 'Ein Reconnect wird erzwungen axcNoHeader = 2 ^ 1 'Die erste Zeile ist keine Kopfzeile. Die Felder werden mit f1, f2...fx angesprochen End Enum
Paramters zum Schreiben der Daten
'/** Public Enum axWriteParams axwNone = 2 ^ 0 'Keine umwandlung axwHeaderRedable = 2 ^ 1 'Titel mit Unterlinien werden aufgetrennt "HAUS_NUMMER" -> "Haus Nummer" End Enum
Als erstes habe ich mir ein Property geschrieben, das eine ADODB-Connection auf das aktuelle Workbook zurückgibt. Da ich mich später nicht darum kümmern will, ob ich die Connection schon geöffnet habe, ist es nach dem Tutorial Funktion mit Cache als Property umgesetzt.
'/** ' * Handle dhe adodb-connection to the current workbook ' * @param axConnParams Paramters für die Connection ' * @param String Pfad zur QuellDatei. Standard ist der Pfad des ausführenden Workbooks ' * @return ADODB.Conection ' */ Private Property Get connection(Optional ByVal iConnParams As axConnParams = axcNone, Optional ByVal iFilePath As String = Empty) As Object
Der Nächste Schritt ist das Öffnen eines ADODB.Recordsets aus dem aktuellen Worksheet. Dazu brauchen wir natürlich die oben erwähnte Connection
'/** ' * Open a adodb recordset from the current workbook ' * @param String SQL-String ' * @param axConnParams Paramters für die Connection ' * @return ADODB.Recordset ' */ Public Function openRs(ByVal iSql As String, Optional ByVal iConnParams As axConnParams = axcNone) As Object
Schreibt den Header in eine Zeile
'/** ' * Write the Header of a adodb.recordset ' * @param Worksheet/Range/Address ' * @param Recordset ' * @param axWriteParams ' */ Public Sub writeHeader(ByRef iRange As Variant, ByRef ioRs As Object, Optional ByVal iWriteParams As axWriteParams = axwNone)
Mit dem einfachen Worksheet.CopyFromRecordset() werden nur die Daten geschrieben. Die folgende Funktion schreibt mittels writeHeader() zuerst die Kopfzeile und dann die Daten
'/** ' * Schreibt ins Excel inkl Header ' * @param Worksheet/Range/Address ' * @param Recordset ' * @param axWriteParams ' */ Public Sub writeFullData(ByRef iRange As Variant, ByRef ioRs As Object, Optional ByVal iWriteParams As axWriteParams = axwNone)
Doch wie greift man mittels SQL jetzt auf die Daten zu? Es gibt mehrere Varianten um die Daten jetzt als Source in einem SQL anzusprechen
Häufig habe ich von Exports aus anderen Systemen gleich ein Worksheet, das genau einer Tabelle entspricht. Die erste Zeile hat die Titel, die folgenden Zeilen sind die Daten. Ich kann mit dem SQL gleich auf diese Daten zugriefen. Die Titel sind dann auch im SQL die Namen der Spalten.
Als Tabellennamen wird einfach der Sheet-Name gefolgt von einem $ verwendet.
-- Auflistung der Vornamen aus dem Sheet 'adress_sheet' SELECT DISTINCT [firstname] FROM [adress_sheet$]
Ich arbeite gerne mit benannten Ranges. so lassens ich sehr einfach Datenbereiche aus einem Sheet auslesen. Dazu einfach in einem Excelsheet einen Range selektionieren und bennen (Dazugibts diverse anleitungen im Web. zB. How to Define a Named Range in Excel). Am besten wählt man ein Bereich mit einer Titelzeile.
Für kleinere Mapping-Tabellen, Stammdaten etc. verwende ich jeweils nur ein Sheet und arbeite dann mit Benannten Ranges.
Da der Benannte Range für das ganze Workbook gültigkeit hat, muss auch kein Sheet angegeben werdn
Im SQL kann dann einfach gleich dieser Name als Quelle verwendet werden.
-- Zugriff auf den Range 'cities', der mitten in einem Sheet ist SELECT [plz], [city] FROM [cities]
Man kann auch auf einen beliebigen Bereich auf einem Sheet zugreifen. Ich rate jedoch davon ab. Adressen Hardcodiert - Never.
sheetName$adress
SELECT * FROM [my_mappings$A3:G17]
[sheetName$]
[rangeName]
[sheetName$adress]
Je nachdem, ob Feldernamen gefunden wurden oder nicht, kann Direkt auf den Feldnamen oder auf die Feldnummer zugegriffen werden.
[feldName]
F#
Ich lese die Daten aus dem Sheet ADDRESS und schreibe eine sie in das Sheet TARGET
Meine Library braucht zwar keine Referenz. Im Beispiel habe ich jedoch den Recordset mit Early Binding gemacht und muss darum eine Referenz aufMicrosoft ActiveX Data Objects 6.1 Library
setzen. Ansonsten den rs als Object definieren
Public Sub sqlTest() Dim rs As ADODB.Recordset Dim ws As Worksheet Set rs = openRs("SELECT [id], [vorname] & ' ' & [nachname] AS [name] " &_ "FROM [address$] " & _ "WHERE id BETWEEN 2 AND 3") Set ws = ActiveWorkbook.Sheets("TARGET") writeFullData ws.Range("A1"), rs rs.Close End Sub
Bei writeFullData() und beim writeHeader() kann man den Paramter iWriteParams auf axwHeaderRedable setzen. Ich zeige hier mal schnell noch den Unterschied. Die Tabelle Hat die 2 Felder
ID | SECURITY_TPE | SECURITY_ID ------------------------------- 1 | T3 | AX3456Z 2 | T3 | AX4564R
Mit dem Standard: iWriteParams = axwNone Die Titelzeile belibt unverändert
writeFullData Sheets("trg").Range("A1"), openRs("select * from [src$]")
ID | SECURITY_TPE | SECURITY_ID ------------------------------- 1 | T3 | AX3456Z 2 | T3 | AX4564R
Mit axwHeaderRedable wird die Titelzeile in eine lesbarere Form gebracht
writeFullData Sheets("trg").Range("A1"), openRs("select * from [src$]"), axwHeaderRedable
Id | Security Tpe | Security Id ------------------------------- 1 | T3 | AX3456Z 2 | T3 | AX4564R
Und hier noch der Code zu den oben bechriebenen Funktionen
Attribute VB_Name = "lib_adodb_for_xls" '------------------------------------------------------------------------------- 'File : lib_adodb_for_xls.bas ' http://http://wiki.yaslaw.info/dokuwiki/doku.php/vba/excel/adodbsql 'Environment : VBA 2010 + 'Version : 1.6.0 'Name : lib_adodb_for_xls 'Author : Stefan Erb (ERS) 'History : 27.01.2016 - ERS - Creation ' 07.08.2017 - ERS - Bei der Connection den optionalen Parameter filePath hinzugefügt. Header Konvertierung hinzugefügt, ZielRange kann jetzt auch ein Worksheet oder eine Adresse sein ' 25.09.2017 - ERS - openRs um den optionalen Wert Connection erweiter. ' 22.01.2018 - ERS - 64Bit Version hinzugefügt '------------------------------------------------------------------------------- Option Explicit '------------------------------------------------------------------------------- ' -- Settings '------------------------------------------------------------------------------- 'https://www.connectionstrings.com/ace-oledb-12-0/ Const C_CONN_STR = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='{#FILEPATH}'; Extended Properties='Excel 12.0;HDR={#HDR};IMEX=1'" '------------------------------------------------------------------------------- ' -- Public Members '------------------------------------------------------------------------------- '/** ' * Paramters zur Connection ' */ Public Enum axConnParams axcNone = 0 axcReconnect = 2 ^ 0 'Ein Reconnect wird erzwungen axcNoHeader = 2 ^ 1 'Die erste Zeile ist keine Kopfzeile. Die Felder werden mit f1, f2...fx angesprochen End Enum '/** ' * Paramters zum Schreiben der Daten ' */ Public Enum axWriteParams axwNone = 2 ^ 0 'Keine umwandlung axwHeaderRedable = 2 ^ 1 'Titel mit Unterlinien werden aufgetrennt "HAUS_NUMMER" -> "Haus Nummer" End Enum '------------------------------------------------------------------------------- ' -- Private Members '------------------------------------------------------------------------------- '/** ' * Die Parameter für das ADODB Objekt ' * https://docs.microsoft.com/en-us/sql/ado/reference/ado-api/open-method-ado-recordset ' */ Private Enum lateBindingAdodbParameters adDate = 7 adDouble = 5 adStateOpen = 1 adCmdText = 1 adUseClient = 3 adOpenDynamic = 2 adOpenStatic = 3 adLockOptimistic = 3 adLockReadOnly = 1 End Enum '------------------------------------------------------------------------------- ' -- Public Methodes '------------------------------------------------------------------------------- '/** ' * Open a adodb recordset from the current workbook ' * @param String SQL-String ' * @param axConnParams Paramters für die Connection ' * @return ADODB.Recordset ' */ Public Function openRs(ByVal iSql As String, Optional ByVal iConnParams As axConnParams = axcNone, Optional ByRef iConnection As Object = Nothing) As Object Dim rsT As Object: Set rsT = CreateObject("ADODB.Recordset") Dim cmd As Object: Set cmd = CreateObject("ADODB.Command") If iConnection Is Nothing Then Set cmd.ActiveConnection = connection(Abs(iConnParams)) 'Der abs() ist false jemand von Früher false übergibt. Else Set cmd.ActiveConnection = iConnection End If cmd.CommandType = adCmdText cmd.CommandText = iSql rsT.CursorLocation = adUseClient rsT.CursorType = adOpenStatic rsT.LockType = adLockReadOnly 'open the recordset rsT.Open cmd 'disconnect the recordset Set rsT.ActiveConnection = Nothing 'cleanup If cmd.State = adStateOpen Then Set cmd = Nothing End If Set openRs = rsT End Function '/** ' * Schreibt ins Excel inkl Header ' * @param Range First cell ' * @param Recordset ' */ Public Sub writeFullData(ByRef iRange As Variant, ByRef ioRs As Object, Optional ByVal iWriteParams As axWriteParams = axwNone) Dim trg As range: Set trg = castRange(iRange) writeHeader trg, ioRs, iWriteParams writeData trg.Offset(1), ioRs End Sub '/** ' * Write the Header of a adodb.recordset ' * @param Range First cell ' * @param Recordset ' */ Public Sub writeHeader(ByRef iRange As Variant, ByRef ioRs As Object, Optional ByVal iWriteParams As axWriteParams = axwNone) Dim trg As range: Set trg = castRange(iRange) Dim colNr As Long Dim delta As Long: delta = trg.Column trg.ClearContents For colNr = 0 To ioRs.fields.count - 1 Dim txt As String: txt = ioRs.fields(colNr).name If Not andB(iWriteParams, axwNone) Then txt = strConv(Join(Split(txt, "_"), " "), vbProperCase) trg.Worksheet.Cells(iRange.row, colNr + delta).Value = txt Next End Sub '/** ' * Schreibt die Daten ' * @param Range ' * @param Recordset ' */ Public Sub writeData(ByRef iRange As Variant, ByRef iRs As Object) Dim trg As range: Set trg = castRange(iRange) trg.ClearContents trg.CopyFromRecordset iRs End Sub '------------------------------------------------------------------------------- ' -- Private Methodes '------------------------------------------------------------------------------- '/** ' * Parst Sheet und String in ein Range ' * @param Worksheet/Range/Address ' * @return Range ' */ Private Function castRange(ByRef iVar As Variant) As range Select Case TypeName(iVar) Case "Worksheet": Set castRange = iVar.UsedRange Case "Range": Set castRange = iVar Case "String": Set castRange = ActiveSheet.range(iVar) End Select End Function '/** ' * Handle dhe adodb-connection to the current workbook ' * @param axConnParams Paramters für die Connection ' * @return ADODB.Conection ' */ Private Property Get connection(Optional ByVal iConnParams As axConnParams = axcNone) As Object Static pConn As Object Static pParams As axConnParams If pConn Is Nothing Or andB(iConnParams, axcReconnect) Or pParams <> iConnParams Then pParams = iConnParams Set pConn = CreateObject("ADODB.Connection") #If Win64 Then pConn.provider = "Microsoft.ACE.OLEDB.12.0" #Else pConn.provider = "Microsoft.Jet.OLEDB.4.0" #End If pConn.connectionString = "Data Source='" & ThisWorkbook.FullName & "'; " & "Extended Properties='Excel 12.0 Xml;HDR=" & IIf(andB(iConnParams, axcNoHeader), "No", "Yes") & ";IMEX=1'" End If If Not (pConn.State And adStateOpen) = adStateOpen Then pConn.Open End If Set connection = pConn End Property '------------------------------------------------------------------------------- ' -- Libraries '------------------------------------------------------------------------------- '/** ' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/functions/andb ' * Macht einen Bit-Vergleich ' * @param Long ' * @param Long ' * @return Boolean ' */ Private Function andB(ByVal iHaystack As Long, ByVal iNeedle As Long) As Boolean andB = ((iHaystack And iNeedle) = iNeedle) End Function