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

本期至此结束，如有不妥或不明白之处，请在评论区留言指正，同时欢迎大家点赞、收藏、转发、关注，下期再见。