SubtotalByCQL Range("A1:E100").Value, "Select 1,2,Sum(4),Count(4) GroupBy 1,2", Range("J1"), True
Sub SubtotalByCQL(ByVal Arr As Variant, ByVal CQL As String, ByVal DesRange As Range, Optional Header As Boolean = False)
Dim i As Long, j As Long, m As Long
Dim Sel As String, Grp As String, Sels, Grps
Dim Ar() As Variant, Br As Variant
Dim Dic As Object
Set Dic = CreateObject("Scripting.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)))
Next 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(Split(Sels(j), "(")(1), ")")(0))) & "-求和"
Case "COUNT"
Ar(m) = Arr(1, CLng(Split(Split(Sels(j), "(")(1), ")")(0))) & "-计数"
End Select
End If
m = m + 1
Next j
Dic(Key) = Ar
End If
For i = 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 = LBound(Sels) To UBound(Sels)
ReDim Preserve Ar(0 To m)
If IsNumeric(Sels(j)) Then
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 "COUNT"
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(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 = Nothing
End Sub