SQL w Excelu Cz1: Formuła =SQL(tabela, where_war1;where_war2)

Niekiedy musimy w Excelu poradzić sobie z dużą ilością połączeń między tabelami albo agregować dane z setek tysięcy rekordów uwzględniając wiele warunków. Powstają wtedy arkusze monstra z setkami tysięcy formuł, które przeliczają się długo. Można obliczenia wyłączyć narażając się na nieaktualne dane. Można też skorzystać z Pivota ale ma on ograniczone możliwości. Aż prosi się, by skorzystać z SQL i silnika bazodanowego, który lepiej radzi sobie z agregowaniem i łączeniem tabel. Ale użytkownicy oczekują od nas formatki w Excelu, nie używają albo nie umieją obsłużyć aplikacji bazodanowych. Co robić?

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")