SQL w Excelu Cz.3: Odpowiednik MS SQL ROLLUP? Voila.

Mój eksperyment. TableA zawiera nieuporządkowaną ofertę po analizie cen. TableB zawiera opisy grup. Chcę uzyskać tabelę oferty z pogrupowanymi i podsumowanymi kodami (na podst. pierwszych trzech liter). Każda grupa powinna zaczynać się od wiersza z opisem grupy. :

SELECT  a as kod, b as wartosc, [Descr] as opis_grupy FROM TableA

UNION ALL SELECT  left(a,3)&"-Total" As kod, sum(b) As wartosc, "" as opis_grupy  FROM TableA

GROUP BY left(a,3)

UNION ALL SELECT a AS kod, "" AS wartosc, [Descr] AS opis_grupy FROM TableB

WHERE a IN (SELECT  left(TableA.a,3)FROM TableA)

UNION ALL SELECT  "-Grand Total-" As kod, sum(b) As wartosc, "" as opis_grupy  FROM TableA
ORDER BY kod;

Realizacja w VBA:

Public Sub SporzadzOferte()
Dim Myconnection As Connection
Dim Myrecordset As Recordset
Dim Myworkbook As String
Dim strSQL As String
Dim i As Integer

'Deal with input data range so that it refers to a Table and not to a Sheet!
'It will allow writing notes and puting a header above the table


Dim rngTableA As String

    rngTableA = Replace(Sheets("TableA").Range("TableA[#All]").Address, "$", "")
    rngTableA = "[TableA$" & rngTableA & "]"
 
'Debug.Print rngTableA


'--------------------

Set Myconnection = New Connection
Set Myrecordset = New Recordset
  
 
  
'Identify the workbook you are referencing
    Myworkbook = Application.ThisWorkbook.FullName

'Open connection to the workbook
   Myconnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                      "Data Source=" & Myworkbook & ";" & _
                      "Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=1'"

'Build SQL Statement

    strSQL = "SELECT  a as kod, b as wartosc, [Descr] as opis_grupy FROM " & rngTableA & " " & _
"UNION ALL SELECT  left(a,3)&'-Total' As kod, sum(b) As wartosc, '' as opis_grupy FROM " & rngTableA & " " & _
"WHERE a IS NOT NULL " & _
"GROUP BY left(a,3)" & _
"UNION ALL SELECT a AS kod, '' AS wartosc, [Descr] AS opis_grupy FROM [TableB$]" & _
"WHERE a IN (SELECT  left(" & rngTableA & ".a,3) FROM " & rngTableA & ") " & _
"UNION ALL SELECT  'zzz-Grand Total-' As kod, sum(b) As wartosc, '' as opis_grupy  FROM " & rngTableA & " " & _
"ORDER BY kod"
 
    

'Load the Query into a Recordset
    Myrecordset.Open strSQL, Myconnection, adOpenStatic

    
'Place the Recordset onto SheetX
   With Sheets("Oferta")
    .Activate
    .ListObjects("Table3").DataBodyRange.Rows.Delete
    .Range("A5").CopyFromRecordset Myrecordset
    
 
    'Add column heading names
    For i = 1 To Myrecordset.Fields.Count
    .Cells(4, i).Value = Myrecordset.Fields(i - 1).Name
    Next i
   
   End With
   
   
   
   Set Myrecordset = Nothing
   Myconnection.Close
   
   Call BoldAndInsertEmptyRow
   
        
End Sub

Teraz jeszcze trzeba sformatować otrzymaną tabelę:

Option Explicit


Sub BoldAndInsertEmptyRow()

    Dim oListObj As ListObject
    Dim RowCnt As Long
    Dim r As Long

    Set oListObj = Worksheets("Oferta").ListObjects("Table3") 'change the sheet and table names accordingly
    
    Application.ScreenUpdating = False
   
' Solve the problem with values not showing up in proper (currency) format but in text format.
    Dim Cell As Range
    
    For Each Cell In oListObj.ListColumns("wartosc").DataBodyRange
    
           With Cell
               If .Value <> "" Then
                   .NumberFormat = "#,##0.00 $"
                   .Value = CCur(Val(.Value))
               End If
           End With
    
    Next Cell

   
    '==========
'Format rows with totals: add empty row above, frame, delete zzz grom Grand Total.
    
    RowCnt = oListObj.ListRows.Count
    
    For r = RowCnt To 1 Step -1
        With oListObj.ListRows(r).Range
            
            'If contains "TOTAL" - bold ent.row and add empty row below.
            
            If InStr(UCase((.Cells(1, 1).Value)), "TOTAL") > 0 Then
                .Font.Bold = True
                
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlDouble
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThick
                End With

                If r < RowCnt Then
                    oListObj.ListRows.Add Position:=r + 1, alwaysinsert:=True
                End If
            End If
            
             ' format rows with description
            
            If .Cells(1, 2).Value = "" Then

                .Cells(1, 1).Font.Bold = True
                
                
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
            
            End If
            
            'remve zzz from Grand Total
            
            If .Cells(1, 1).Value = "zzz-Grand Total-" Then
                    .Cells(1, 1).Value = "Grand Total"
            End If
            
        End With
    Next r


Application.ScreenUpdating = True

End Sub

Przykładowy plik tutaj.

Ciekawe strony na ten temat:
http://stackoverflow.com/questions/1839214/add-a-summary-row-to-ms-access-query
http://stackoverflow.com/questions/7157764/roll-up-and-cube-operator-in-access-summary-queries
https://technet.microsoft.com/en-us/library/bb510427(v=sql.105).aspx
http://p2p.wrox.com/access-vba/24326-roll-up-cube-compute-aggregate-funct-access.html

Również ciekawe, o subqueries:
http://allenbrowne.com/subquery-01.html
http://allenbrowne.com/subquery-02.html
http://stackoverflow.com/questions/11646664/querying-two-tables-in-ms-access?rq=1