1. Potrzebny jest MS Access runtime, nic nie kosztuje, do ściągnięcia tutaj: najnowszy: http://www.microsoft.com/pl-pl/download/details.aspx?id=39358, może być starszy (2010, 2007)
2. W edytorze VBA Excela należy w menu Tools/References włączyć Microsoft ActiveX Data Objects x.x Library. Jeśli jest kilka można wybrać najnowszą wersję.
3. A oto funkcja użytkownika (UDF), która na zaznaczonej w Excelu tabeli wykonuje kwerendę SQL. Możemy stworzyć kilka takich formuł, odpowiednio je nazywając. Kod wklejamy do nowego modułu w edytorze VBA do którego dostaniemy się wciskając Alt+F11. Jest to funkcja tablicowa, tj. należy zaznaczyć więcej komórek by pomieścić wynik zapytania SQL, wpisać formułę i zatwierdzić wciskając Ctrl+Shift+Enter. Liczbę parametrów można łatwo zmienić pamiętając o prawidłowym przypisaniu typu zmiennym i prawidłowym "wstrzyknięciu" ich do łańcucha tekstowego zapytania SQL - można np. dodać drugi zakres danych a w zapytaniu SQL dodać połączenie tabel LEFT JOIN - by łączyć tabele szybciej niż za pomocą VLOOKUPa.
Function SQL(dataRange As Range, CritA As String, CritB As Double) As Variant
Function SQL(dataRange As Range, CritA As String, CritB As Double) As Variant
Application.Volatile
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim currAddress As String
Dim varHdr, varDat, contentOut As Variant
Dim nc, nr, i, j As Long
SQL = Null
currAddress = ActiveSheet.Name & "$" & dataRange.Address(False, False)
strFile = ThisWorkbook.FullName
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=0"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient ' required to return the number of rows correctly
cn.Open strCon
strSQL = "SELECT * FROM [" & currAddress & "]" & _
"WHERE [A] = '" & CritA & "' AND [B] >= " & CritB & " " & _
"ORDER BY 10 DESC"
rs.Open strSQL, cn
'Check if recordset is empty
If rs.EOF Then
MsgBox "Function does not return any values"
SQL = ""
Exit Function
End If
' Process Column Headings
nc = rs.Fields.Count
ReDim varHdr(nc - 1, 0)
For i = 0 To rs.Fields.Count - 1
varHdr(i, 0) = rs.Fields(i).Name
Next
' Get Rows from the Recordset
nr = rs.RecordCount
varDat = rs.GetRows
' Combing Header and Data and Transpose
ReDim contentOut(0 To nr, 0 To nc - 1)
For i = 0 To nc - 1
contentOut(0, i) = varHdr(i, 0)
Next
For i = 1 To nr
For j = 0 To nc - 1
contentOut(i, j) = varDat(j, i - 1)
Next
Next
' Optional solution: Write Output Array to Sheet2
' With Sheet2
' .Cells.Clear
' .Range("A1").Resize(nr, nc) = contentOut
' End With
'Figure out size of calling range which will receive the output array
Dim nRow As Long: nRow = Application.Caller.Rows.Count
Dim nCol As Long: nCol = Application.Caller.Columns.Count
'Error if calling range too small
If nRow < UBound(contentOut, 1) Or nCol < UBound(contentOut, 2) Then
'Popup message
'MsgBox "your range is too small."
' or return #VALUE! error
SQL = "Too small range" 'CVErr(xlValue)
' or both or whatever else you want there to happen
Exit Function
End If
'Initialise output array to match size of calling range
Dim varOut As Variant
ReDim varOut(1 To nRow, 1 To nCol)
'And fill it with some background value
Dim iRow As Long
Dim iCol As Long
For iRow = 1 To nRow
For iCol = 1 To nCol
varOut(iRow, iCol) = "" ' or "funny bear", or whatever
Next
Next
'Put content in output array and return
For iRow = 0 To UBound(contentOut, 1)
For iCol = 0 To UBound(contentOut, 2)
varOut(iRow + 1, iCol + 1) = contentOut(iRow, iCol)
Next
Next
SQL = varOut
'Cleanup
Erase contentOut
Erase varHdr
Erase varDat
rs.Close
Set rs = Nothing
Set cn = Nothing
End Function
Przykładowy plik tutaj.
Źródła/Credits:
Makro poniższe jest jedynie moim skromnym rozwinięciem rozwinięciem pytania innego użytkownika na forum Stackoverflow: "Performing SQL queries on an Excel Table within a Workbook with VBA Macro".
Skorzystałem z podpowiedzi na forum MrExcel jak zwrócić tablicę (array) z recordset'u http://www.mrexcel.com/forum/excel-questions/842976-excel-udf-return-array-ace-sql-recordset.html#post4104616 dzięki skorzystąłem też pomocy m.in. Jean-François Corbett'a (wskazanie błędu 'za mały zakres' i wypełnienie pustymi nadmiarowych komórek zamiast "#N/A")
