20170928xlVBA Custom Subtotals

SUBTOTALBYCQL Range ("a1:e100"). Value, "Select 1,2,sum (4), Count (4) GroupBy", Range ("J1"), Truesub subtotalbycql (ByVal Arr as Variant, ByVal CQL as Str ING, ByVal desrange as Range, Optional Header as Boolean = False) Dim i As Long, j as long, m as long Dim Sel as Str ING, Grp as String, Sels, GRPs Dim Ar () As Variant, Br As Variant Dim Dic as Object Set dic = CreateObject ("Scrip Ting. Dictionary ") CQL = UCase (CQL) Sel = replace (replace (Split (CQL," GROUPBY ") (0)," "," ")," select "," ") Sels =        Split (Sel, ",") GRP = Replace (Split (CQL, "GROUPBY") (1), "", "") GRPs = Split (GRP, ",") If Header Then Key = "" For j = LBound (GRPs) to UBound (GRPs) key = key & ";" & Arr (1, CLng (GRPs (j))) Ne            XT J Key = Mid (Key, 2) ReDim Ar (0 to 0) m = 0 for j = LBound (Sels) to UBound (Sels)  ReDim Preserve ar (0 to M) If IsNumeric (Sels (j)) then Ar (m) = ARR (1, CLng (Sels (j)))          Else Select Case Split (Sels (J), "(") (0) case "SUM" Ar (m) = ARR ( 1, CLng (Split (Sels (J), "(") (1), ")") (0)) & "-summation" case "COUNT" Ar (m) = ARR (1,        CLng (Split (Sels (J), "(") (1), ")") (0)) & "-Count" End Select End If m = m + 1         Next J Dic (Key) = Ar End If for me = LBound (arr) + IIf (Header, 1, 0) to UBound (arr) Key = ""        for j = LBound (GRPs) to UBound (GRPs) key = key & ";" & Arr (i, CLng (GRPs (j))) Next J Key = Mid (key, 2) If not dic.exists (key) then ReDim Ar (0 to 0) m = 0 for j = LB Ound (Sels) to UBound (Sels) ReDim Preserve Ar (0 to M) If IsNumeric (Sels (j)) T Hen Ar (m) = ARR (i, CLng (Sels (j))) Else Select case Split (Sels (J), "("                    ) (0)Case "SUM" Ar (m) = ARR (i, CLng (Split (Split (Sels (J), "(") (1), ")") (0)) case "COU            NT "Ar (m) = 1 End Select end If m = m + 1                Next J Dic (key) = Ar Else Br = Dic (key) for j = LBound (Sels) to UBound (Sels)                    If IsNumeric (Sels (j)) then Else Select case Split (Sels (J), "(") (0)                    Case "SUM" br (j) = BR (j) + ARR (i, CLng (Split (Sels (J), "(") (1), ")") (0))            Case "COUNT" br (j) = BR (j) + 1 End Select End If Next J Dic (Key) = Br End If Next i desrange.resize (Dic.count, UBound (Sels) + 1). Value = _ Application.rept (dic.items, 1) Set Dic = NothingEnd Sub

　　

20170928xlVBA Custom Subtotals