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