Excel VBA 与 SQL 语言的综合运用

Excel 中使用VBA可以极大地提高工作效率，如果将VBA与SQL语言（Structured Query Language，简称SQL）结合起来使用，处理数据起来那更是如鱼得水，如虎添翼，锦上添花。可喜可贺的是，该语言简洁，易学易用，可以嵌套，具有极大的灵活性和强大的功能。今天我带你领略VBA与SQL语言汇总数据的风采。

一、基础数据（原始数据）

图1 用工费

二、汇总数据表

图2 汇总数据表

三、模块代码

1、VBA之字典汇总，代码如下：

Sub dic_groupby()

Dim arr,t
Dim d As New Dictionary
Dim i As Integer, k%, j%
Dim sh1 As Worksheet, sh2 As Worksheet

Set d = CreateObject("Scripting.Dictionary")
'创建字典

Set sh1 = Sheets("总表")
Set sh2 = Sheets("用工费")

arr = sh2.Range("a1").CurrentRegion
sh1.Range("a1:f500").ClearContents
sh1.[a1:g1] = Array("id", "name", "corn", "millet", "rapeseed", "other", "ALL")

For i = 2 To UBound(arr)
If d.Exists(arr(i, 2)) Then
d(arr(i, 2)) = Array(d(arr(i, 2))(0) + arr(i, 3), d(arr(i, 2))(1) + arr(i, 4), d(arr(i, 2))(2) + arr(i, 5), d(arr(i, 2))(3) + arr(i, 6))
Else
d(arr(i, 2)) = Array(arr(i, 3), arr(i, 4), arr(i, 5), arr(i, 6))
End If
Next i
'通过循环进行汇总

t = d.Keys
t = WorksheetFunction.Transpose(t)
'对字典的键进行转置

sh1.[b2].Resize(d.Count) =t
'将字典的键放入sh1里面的b2单元格起始的位置，行扩展数量为d.count，默认一列。

sh1.[C2].Resize(d.Count, 4) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(d.Items))
'对字典的键对应的数值进行双重转置后放入C2单元格起始的位置，行扩展数量为d.count,4列。

sh1.Range("a" & d.Count + 2).Offset(0, 2) = WorksheetFunction.Sum(Range("C2:C" & d.Count + 1))
sh1.Range("a" & d.Count + 2).Offset(0, 3) = WorksheetFunction.Sum(Range("D2:D" & d.Count + 1))
sh1.Range("a" & d.Count + 2).Offset(0, 4) = WorksheetFunction.Sum(Range("E2:E" & d.Count + 1))
sh1.Range("a" & d.Count + 2).Offset(0, 5) = WorksheetFunction.Sum(Range("F2:F" & d.Count + 1))
'对相应的列求和计算

For j = 1 To d.Count
sh1.Range("a" & j + 1) = j
sh1.Range("G" & j + 1) = WorksheetFunction.Sum(Range("C" & j + 1 & ":F" & j + 1))
Next j
'行方向求和

sh1.Range("a" & j + 1) = "Total"
sh1.Range("a" & j + 1).Offset(0, 1) = "ALL"
sh1.Range("G" & d.Count + 2) = WorksheetFunction.Sum(Range("G2:G" & d.Count + 1))

End Sub

2、VBA之SQL语句汇总，代码如下：

Option Explicit
Sub sql_query()

Dim path As String,sq1 As String
Dim i As Integer
Dim conn As Object,rs As Object
Dim sh As Worksheet

Set sh = Sheets("总表")
Set conn = CreateObject("adodb.connection")
'创建连接对象

sh.Range("A1:G100").ClearContents
path = ThisWorkbook.FullName

If Application.Version < 12 Then
conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & path
Else
conn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & path
End If

sq1 = "select name ,sum(corn)as corn ,sum(millet)as millet ,sum(rapeseed) as rapeseed ,sum(other) as other, sum(corn)+sum(millet)+sum(rapeseed)+sum(other)as total from[用工费$] GROUP BY name order by name desc"
'设置SQL查询语句

Set rs = conn.Execute(sq1)
'设置结果集对象

sh.[A2].CopyFromRecordset rs
'拷贝结果集至A2单元格起始的位置

For i = 1 To rs.fields.Count
sh.Cells(1, i) = rs.fields(i - 1).name
Next i
'设置字段名

conn.Close

Set conn = Nothing
Set rs = Nothing

End Sub