VBA代码全集模板

1、目 录一、引用2二、Worksheet_Change 事件：2三、相乘4四、相减5五、高级筛选5六、双击事件7七单位汇总（sumif），单条件汇总9八、多条件汇总 （连接、sumif）12九、多条件汇总、ado14十、对账15十一、sql筛选19十二、sql连接、交叉汇总20十三、select语句总结22十四、报表（有层次）23一、引用相对引用B4绝对引用$B$4混合引用$B4、B$4 F4进行引用切换，$在字母前面则锁定列，在数字前面则锁定行。二、Worksheet_Change 事件：1.在单元格中C4=VLOOKUP(B4,简码表!$B$4:$C$1000,2,FALSE)2. Work

2、sheet_Change事件代码：Private Sub Worksheet_Change(ByVal Target As Range)On error resume next出现错误时，后面接着运行If Target.Row 3对象行大于3 And Target.Column = 2 对象列等于2Theni = Target.RowCells(i, 3) = Application.WorksheetFunction.VLookup(Cells(i, 2), Sheets(简码表).Range(b4:c100)结果运行的引用范围, 2结果运行的引用范围从第2列开始查找, False)End

3、IfEnd Sub备查代码：Private Sub Worksheet_Change(ByVal Target As Range)On Error Resume NextIf Target.Row 3 And Target.Column = 5 Theni = Target.RowCells(i, 6) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets(类款项).Range(b2:e2000), 2, False)Cells(i, 7) = Application.WorksheetFunction.VLookup(Cell

4、s(i, 5), Sheets(类款项).Range(b2:e2000), 3, False)Cells(i, 8) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets(类款项).Range(b2:e2000), 4, False)End IfEnd Sub三、相乘Sub 计算金额()Application.ScreenUpdating = FalseDim i As LongDim irow As Longirow = Range(a3).End(xldown).Row计算3行以下的内容For i = 4 To irowCe

5、lls(i, 3) = Cells(i, 1) * Cells(i, 2)Next i继续运行下一个结果Application.ScreenUpdating = TrueEnd Sub四、相减Sub 相减()Application.ScreenUpdating = False关屏Range(c3:c10000).ClearContents运行时删除单元格里先前的内容Dim i As LongDim irow As Long范围较大时，用来定义范围irow = Range(a5000).End(xlUp).Row计算5000行以上的范围For i = 3 To irowCells(i, 3) =

6、 VBA.Round(Cells(i, 1) - Cells(i, 2), 2当基数为非整数时，结果保留到小数点后两位)Next iApplication.ScreenUpdating = TrueEnd Sub五、高级筛选 （工具-宏-录制新宏，宏名改成高级筛选）Sub 高级筛选() Sheets(业务).Range(A3:I10000)列表区域.AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=ActiveCell.Range(A1:B1)复制区域, Unique:=True筛选结果是唯一的End Sub六、双击事件1.插入-名称-定义

7、（修改名称和引用位置）2查看代码-插入-用户窗体 工具箱-多页、列表框-右键属性点击page1修改caption为资产类-点击空白列表框修改rowsource为box1依次类推3. 业务表-查看代码 Worksheet beforedoubleclickPrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Target.Row 3 And Target.Column = 6 ThenUserForm1.ShowSheets(初始化).Range(m3) = ActiveCell活动

8、单元格内容显示工作表“初始化”的单元格m3中ElseIf Target.Row 3 And Target.Column = 7 ThenUserForm2.ShowEnd IfEnd Sub备查代码：Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Target.Row 3 And Target.Column = 6 ThenUserForm1.ShowSheets(初始化).Range(c2) = ActiveCellElseIf Target.Row 3 And Targe

9、t.Column = 7 ThenUserForm2.ShowSheets(初始化).Range(f2) = ActiveCellElseIf Target.Row 3 And Target.Column = 8 ThenUserForm3.ShowEnd IfEnd Sub4右键点击Userform1查看代码 Listbox1 dbclickPrivate Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBo

10、x1.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox2.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = Li

11、stBox1.List(ListBox3.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox4.ListIndex, 0)Unload MeEnd SubPrivate Sub ListBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(Activ

12、eCell.Row, 6) = ListBox1.List(ListBox5.ListIndex, 0)Unload MeEnd Sub见上图5.插入用户窗体 右键点击userform2 worksheet dblclick Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 7) = ListBox1.List(ListBox1.ListIndex, 0)Unload MeEnd SubUserform initializePrivate S

13、ub UserForm_Initialize()Application.ScreenUpdating = FalseWith Sheets(初始化)Sheets(科目表).Range(h2:i10000).AdvancedFilter Action:=xlFilterCopy, _CriteriaRange:=.Range(m2:m3), CopyToRange:=.Range(n2), Unique:=TrueEnd WithApplication.ScreenUpdating = TrueEnd Sub七单位汇总（sumif），单条件汇总=SUMIF(业务!$D$4:$D$1000,单位汇

14、总!$A15,业务!I$4:I$10000)Sub 单位汇总1()Application.ScreenUpdating = Falserange(a1:i10000).ClearCells(3, 2) = 指标数Cells(3, 3) = 拨款数Cells(3, 4) = 余额Cells(1, 7) = 单位Cells(3, 7) = 单位Cells(3, 8) = 指标数Cells(3, 9) = 拨款数Sheets(业务).Range(D3:D10000).AdvancedFilter Action:=xlFilterCopy, _CopyToRange:=Range(A3), Uniqu

15、e:=TrueSheets(业务).Range(A3:J10000).AdvancedFilter Action:=xlFilterCopy, _CriteriaRange:=Range(G1:G2), CopyToRange:=Range(G3:I3), Unique:=FalseDim i As LongDim irow As Longirow = Range(a3).End(xlDown).RowFor i = 4 To irowCells(i, 2) = Application.WorksheetFunction.SumIf(Range(g4:g10000)单位列, Cells(i,

16、1), Range(h4:h10000)Cells(i, 3) = Application.WorksheetFunction.SumIf(Range(g4:g10000), Cells(i, 1)条件单元格, Range(i4:i10000)数字来源)Cells(i, 4) = VBA.Round(Cells(i, 2) - Cells(i, 3), 2)Next iRange(g1:i10000).Clear运行结束后清空单元格Application.ScreenUpdating = TrueEnd Sub八、多条件汇总 （连接、sumif）连接=k4&l4&m4&n4Vba：Sub 多条

17、件汇总()Application.ScreenUpdating = FalseRange(a1:p10000).ClearSheets(业务).Range(D3:G10000).AdvancedFilter Action:=xlFilterCopy, _CopyToRange:=Range(B3:E3), Unique:=TrueSheets(业务).Range(D3:I10000).AdvancedFilter Action:=xlFilterCopy, _CopyToRange:=Range(K3:P3), Unique:=FalseDim j As LongDim jrow As Lon

18、gjrow = Range(k3).End(xlDown).RowFor j = 4 To jrowCells(j, 10) = Cells(j, 11) & Cells(j, 12) & Cells(j, 13) & Cells(j, 14)Next jDim i As LongDim irow As Longirow = Range(b3).End(xlDown).RowFor i = 4 To irowCells(3, 6) = 指标数Cells(3, 7) = 拨款数Cells(3, 8) = 余额Cells(i, 1) = Cells(i, 2) & Cells(i, 3) & Ce

19、lls(i, 4) & Cells(i, 5)条件连接Cells(i, 6) = Application.WorksheetFunction.SumIf(Range(j4:j10000), Cells(i, 1), Range(o4:o10000)Cells(i, 7) = Application.WorksheetFunction.SumIf(Range(j4:j10000), Cells(i, 1), Range(p4:p10000)Cells(i, 8) = VBA.Round(Cells(i, 6) - Cells(i, 7), 2)Next iRange(i3:p10000).Cle

20、ar删除内容及格式Range(a1:a10000).Delete删除整列Application.ScreenUpdating = TrueEnd Sub九、多条件汇总、adoSub 多条件汇总()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.Connection连接Dim rst As New ADODB.Recordset记录集cnn.Open Provider供应者=Microsoft.Jet.OLEDB.4.0;Extended Properties扩展

21、属性=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql = SELECT 单位,类,款,项, sum(指标数) as 预算股指标,sum(拨款数) as 预算股拨款 from业务$a3:J10000 where 归口= & Range(h2).Value & and 月= & Range(i2).Value & GROUP BY 单位,类,款,项按照需要进行修改rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets(多条件汇总).Cells(3, i按照需要进行修改)

22、 = rst.Fields(i - 1).NameNext iSheets(多条件汇总).Range(a4按照需要进行修改).CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd Sub十、对账Sub 预算股()Application.ScreenUpdating = FalseDim i As IntegerDim strsql1 As StringDim cnn1 As New ADODB.ConnectionDim rst1

23、 As New ADODB.Recordsetcnn1.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullName固定格式，无需修改strsql1 = SELECT 单位,类,款,项, sum(指标数对指标数进行分类汇总) as 预算股指标 from预算股$a3:m50000数据来源 where 归口= & Range(h2).Value & and 月= & Range(i2).Value & GROUP BY 单位,类,款,项

24、rst1.Open strsql1, cnn1For i = 1 To rst1.Fields.CountSheets(对帐).Cells(3, i + 10) = rst1.Fields(i - 1).NameNext iSheets(对帐).Range(k4).CopyFromRecordset rst1rst1.Closecnn1.CloseSet rst1 = NothingSet cnn1 = Nothing固定格式，无需修改Dim strsql2 As StringDim cnn2 As New ADODB.ConnectionDim rst2 As New ADODB.Recor

25、dsetcnn2.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql2 = SELECT 单位,类,款,项, sum(指标数) as 专业股指标 from专业股$a3:j50000 where条件 归口= & Range(h2).Value & and 月= & Range(i2).Value & 当单元格内容为数字时，不需要单引号 GROUP BY 单位,类,款,项按单位类款项进行汇总rst2.Open st

26、rsql2, cnn2For i = 1 To rst2.Fields.CountSheets(对帐).Cells(3, i + 19) = rst2.Fields(i - 1).NameNext iSheets(对帐).Range(t4).CopyFromRecordset rst2结果从t4单元格开始显示rst2.Closecnn2.CloseSet rst2 = NothingSet cnn2 = Nothings = Application.WorksheetFunction.CountA(Range(k4:k10000)计算非空单元格个数 + 4从第四行开始计算非空单元格，如果只有k

27、4和k5两个非空单元格，那么数据应该复制在k6，2+4=6，所以应该+4Range(T4:W10000).Select Selection.Copy Range(K & s).Select ActiveSheet.Paste Range(X4:X10000).Select Selection.Copy Range(P & s).Select ActiveSheet.Paste Range(X3).Select Selection.Copy Range(P3).Select ActiveSheet.Paste录制宏进行复制 Dim strsql As StringDim cnn As New A

28、DODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql = SELECT 单位,类,款,项, sum(预算股指标) as 预算股指标 ,sum(专业股指标) as 专业股指标 from对帐$k3:p50000 GROUP BY 单位,类,款,项rst.Open strsql, cnnFor i = 1 To rst.F

29、ields.CountSheets(对帐).Cells(3, i) = rst.Fields(i - 1).NameNext iSheets(对帐).Range(a4).CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd Sub十一、sql筛选Sub 筛选()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New A

30、DODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql = SELECT distinct筛选成唯一、不重复数据 单位,类,款,项 from专业$a3:h10000rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets(筛选).Cells(3, i) = rst.

31、Fields(i - 1).NameNext iSheets(筛选).Range(a4).CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd Sub十二、sql连接、交叉汇总Sub 连接()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB

32、.Recordsetcnn.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql = SELECT 股,月,归口,单位,类,款,项,指标数 from 专业$a3:h10000 union ALL连接全部内容 SELECT 股,月,归口,单位,类,款,项,指标数 from 预算$a3:l10000 order by 股 desc按股的降序排列rst.Open strsql, cnnFor i = 1 To rst.

33、Fields.CountSheets(连接).Cells(1, i + 19) = rst.Fields(i - 1).NameNext iSheets(连接).Range(t2).CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 汇总()Application.ScreenUpdating = FalseCall 连接Dim i As IntegerDim strsql As StringDim cnn As

34、New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql = transform sum(指标数)对指标数进行交叉汇总 SELECT 单位,类,款,项 from 连接$t1:aa10000 where 归口= & Range(h2).Value & and 月= & Range(i2).Value & grou

35、p by 单位,类,款,项 pivot 股按股进行交叉汇总rst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets(连接).Cells(3, i) = rst.Fields(i - 1).NameNext iSheets(连接).Range(a4).CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingRange(t1:aa10000).ClearContentsApplication.ScreenUpdating = TrueEnd Sub十三、s

36、elect语句总结1、筛选（false -筛选全部）Select 列表名称1,列表名称2,.列表名称n from 表$区域或者Select * from 表$区域2、筛选唯一的数据Select distinct 列表名称1,列表名称2,.列表名称n from 表$区域3、分类汇总Select 列表名称1,列表名称2,.列表名称n，sum(a) as a from 表$区域Group by列表名称1,列表名称2,.列表名称n4、条件分类汇总Select 列表名称1,列表名称2,.列表名称n，sum(a) as a from 表$区域Where 归口=”& range(“”).value &” a

37、nd 月=”& range(“”).value &” Group by列表名称1,列表名称2,.列表名称n5、交叉汇总Transform sum() select 列名称1,列名称n from表$区域 group by 列名称1，.列名称n pivot 交叉事项6、连接Select 列名称1，列名称n from表$区域 union all Select 列名称1，列名称n from表$区域 order by 列名称 desc十四、报表（有层次）连接Transform sum（指标数），pivot 股 按单位、类、款进行汇总按单位、类进行汇总按单位进行汇总连接以上四个表的内容，并按单位、类、款、

38、项进行排序，其中单位按降序排序1、整体写代码Sub 报表()Application.ScreenUpdating = FalseDim i As IntegerDim strsql1 As StringDim cnn1 As New ADODB.ConnectionDim rst1 As New ADODB.Recordsetcnn1.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql1 = SELECT 股,

39、月,归口,单位,类,款,项,sum(指标数) as 指标数 from专业$a3:h10000 group by 股,月,归口,单位,类,款,项 union all SELECT 股,月,归口,单位,类,款,项,sum(指标数) as 指标数 from预算$a3:l10000 group by 股,月,归口,单位,类,款,项 order by 股 descrst1.Open strsql1, cnn1For i = 1 To rst1.Fields.CountSheets(报表).Cells(3, i + 9) = rst1.Fields(i - 1).NameNext iSheets(报表).

40、Range(j4).CopyFromRecordset rst1rst1.Closecnn1.CloseSet rst1 = NothingSet cnn1 = NothingDim strsql2 As StringDim cnn2 As New ADODB.ConnectionDim rst2 As New ADODB.Recordsetcnn2.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql2 = t

41、ransform sum(指标数) SELECT 单位,类,款,项 from报表$j3:q10000 where 归口= & Range(g2) _.Value & and 月= & Range(h2).Value & group by 单位,类,款,项 order by 单位 desc pivot 股 rst2.Open strsql2, cnn2For i = 1 To rst2.Fields.CountSheets(报表).Cells(3, i + 19) = rst2.Fields(i - 1).NameNext iSheets(报表).Range(t4).CopyFromRecord

42、set rst2rst2.Closecnn2.CloseSet rst2 = NothingSet cnn2 = NothingDim strsql3 As StringDim cnn3 As New ADODB.ConnectionDim rst3 As New ADODB.Recordsetcnn3.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql3 = SELECT 单位,类,款,sum(专业股) as

43、 专业股,sum(预算股) as 预算股 from报表$t3:y10000 group by 单位,类,款 order by 单位 descrst3.Open strsql3, cnn3For i = 1 To rst3.Fields.CountSheets(报表).Cells(3, i + 26) = rst3.Fields(i - 1).NameNext iSheets(报表).Range(aa4).CopyFromRecordset rst3rst3.Closecnn3.CloseSet rst3 = NothingSet cnn3 = NothingDim strsql4 As Str

44、ingDim cnn4 As New ADODB.ConnectionDim rst4 As New ADODB.Recordsetcnn4.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql4 = SELECT 单位,类,sum(专业股) as 专业股,sum(预算股) as 预算股 from报表$t3:y10000 group by 单位,类 order by 单位 descrst4.Open strsql

45、4, cnn4For i = 1 To rst4.Fields.CountSheets(报表).Cells(3, i + 32) = rst4.Fields(i - 1).NameNext iSheets(报表).Range(ag4).CopyFromRecordset rst4rst4.Closecnn4.CloseSet rst4 = NothingSet cnn4 = NothingDim strsql5 As StringDim cnn5 As New ADODB.ConnectionDim rst5 As New ADODB.Recordsetcnn5.Open Provider=M

46、icrosoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql5 = SELECT 单位,sum(专业股) as 专业股,sum(预算股) as 预算股 from报表$t3:y10000 group by 单位 order by 单位 descrst5.Open strsql5, cnn5For i = 1 To rst5.Fields.CountSheets(报表).Cells(3, i + 37) = rst5.Fields(i - 1).Name

47、Next iSheets(报表).Range(al4).CopyFromRecordset rst5rst5.Closecnn5.CloseSet rst5 = NothingSet cnn5 = Nothing Columns(AD:AD).Select Selection.Insert Shift:=xlToRight Range(ad3) = 项 Columns(Aj:Ak).Select Selection.Insert Shift:=xlToRight Range(aj3) = 款 Range(ak3) = 项 Columns(Ap:Ar).Select Selection.Inse

48、rt Shift:=xlToRight Range(ap3) = 类 Range(aq3) = 款 Range(ar3) = 项 Dim strsql6 As StringDim cnn6 As New ADODB.ConnectionDim rst6 As New ADODB.Recordsetcnn6.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql6 = SELECT 单位,类,款,项,专业股,预算股

49、from 报表$t3:y10000 union all SELECT 单位,类,款,项,专业股,预算股 from 报表$aa3:af10000 union all SELECT 单位,类,款,项,专业股,预算股 from 报表$ah3:am10000 union all SELECT 单位,类,款,项,专业股,预算股 from 报表$ao3:at10000 order by 单位 desc,类,款,项 rst6.Open strsql6, cnn6For i = 1 To rst6.Fields.CountSheets(报表).Cells(3, i) = rst6.Fields(i - 1).

50、NameNext iSheets(报表).Range(a4).CopyFromRecordset rst6rst6.Closecnn6.CloseSet rst6 = NothingSet cnn6 = NothingRange(j1:au10000).ClearContentsDim p As LongDim prow As Longprow = Range(a3).End(xlDown).RowFor p = 4 To prowRange(g3) = 金额Cells(p, 7) = VBA.Round(Cells(p, 6) - Cells(p, 5), 2)Next pApplicati

51、on.ScreenUpdating = TrueEnd Sub2、分开写代码：Sub 连接()Application.ScreenUpdating = FalseDim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql

52、 = SELECT 月,归口,股,单位,类,款,项,sum(指标数) as 指标数 from专业$a3:h10000 group by 月,归口,股,单位,类,款,项 union all SELECT 月, 归口,股,单位,类,款,项,sum(指标数) as 指标数 from预算$a3:l10000 group by 月, 归口,股,单位,类,款,项 order by 股 descrst.Open strsql, cnnFor i = 1 To rst.Fields.CountSheets(报表).Cells(3, i + 9) = rst.Fields(i - 1).NameNext iSh

53、eets(报表).Range(j4).CopyFromRecordset rstrst.Closecnn.CloseSet rst = NothingSet cnn = NothingApplication.ScreenUpdating = TrueEnd SubSub 项()Application.ScreenUpdating = FalseCall 连接Dim i As IntegerDim strsql As StringDim cnn As New ADODB.ConnectionDim rst As New ADODB.Recordsetcnn.Open Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Hdr=Yes;Data Source= & ThisWorkbook.FullNamestrsql = transform sum(指标数) SELECT 单位,类,款,项 from 报表$j3:q10000 where 归口= & Range(g2).Value & and 月= & Range(h2).Value & group by