admin管理员组文章数量:1531659
2024年6月28日发(作者：)
VBA代码全集
目 录
一、引用 .................................................................. 2
二、Worksheet_Change 事件： ........................................... 2
三、相乘 .................................................................. 4
四、相减 .................................................................. 5
五、高级筛选 ............................................................ 5
六、双击事件 ............................................................ 7
七．单位汇总（sumif），单条件汇总 ................................ 9
八、多条件汇总 （连接、sumif） .................................. 12
九、多条件汇总、ado .................................................. 14
十、对账 ................................................................. 15
十一、sql筛选 ........................................................... 19
十二、sql连接、交叉汇总 ........................................... 20
十三、select语句总结 ................................................. 22
十四、报表（有层次） .............................................. 23
云南农业大学
1
VBA代码全集
一、引用
相对引用B4
绝对引用$B$4
混合引用$B4、B$4
F4进行引用切换，$在字母前面则锁定列，在数字前面则锁定行。
二、Worksheet_Change 事件：
1.在单元格中C4=VLOOKUP(B4,简码表!$B$4:$C$1000,2,FALSE)
2. Worksheet_Change事件代码：
Private Sub Worksheet_Change(ByVal Target As Range)
On error resume next
If > 3 And = 2 Then
i =
Cells(i, 3) = p(Cells(i, 2), Sheets("简码表
云南农业大学
2
VBA代码全集
").Range("b4:c100"), 2, False)
End If
End Sub
备查代码：
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If > 3 And = 5 Then
i =
Cells(i, 6) = p(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 2,
False)
Cells(i, 7) = p(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 3,
云南农业大学
3
VBA代码全集
False)
Cells(i, 8) = p(Cells(i, 5), Sheets("类款项").Range("b2:e2000"), 4,
False)
End If
End Sub
三、相乘
Sub 计算金额()
Updating = False
Dim i As Long
Dim irow As Long
irow = Range("a3").End(xldown).Row
For i = 4 To irow
Cells(i, 3) = Cells(i, 1) * Cells(i, 2)
Next i
Updating = True
End Sub
云南农业大学
4
VBA代码全集
四、相减
Sub 相减()
Updating = False
Range("c3:c10000").ClearContents
Dim i As Long
Dim irow As Long
irow = Range("a5000").End(xlUp).Row
For i = 3 To irow
Cells(i, 3) = ((Cells(i, 1) - Cells(i, 2)), 2)
Next i
Updating = True
End Sub
五、高级筛选
（工具-宏-录制新宏，宏名改成高级筛选）
云南农业大学
5
VBA代码全集
Sub 高级筛选()
Sheets("业务").Range("A3:I10000").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=("A1:B1"), Unique:=True
End Sub
云南农业大学
6
VBA代码全集
六、双击事件
1.插入-名称-定义（修改名称和引用位置）
2．查看代码-插入-用户窗体
工具箱-多页、列表框-右键属性
点击page1修改caption为资产类-点击空白列表框修改rowsource
为box1
依次类推
3. 业务表-查看代码 Worksheet beforedoubleclick
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If > 3 And = 6 Then
Sheets("初始化").Range("m3") = ActiveCell
云南农业大学
7
VBA代码全集
ElseIf > 3 And = 7 Then
End If
End Sub
备查代码：
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If > 3 And = 6 Then
Sheets("初始化").Range("c2") = ActiveCell
ElseIf > 3 And = 7 Then
Sheets("初始化").Range("f2") = ActiveCell
ElseIf > 3 And = 8 Then
End If
End Sub
4．右键点击Userform1查看代码 Listbox1 dbclick
Private Sub ListBox1_DblClick(ByVal Cancel As Boolean)
(, 6) = (dex, 0)
Unload Me
End Sub
Private Sub ListBox2_DblClick(ByVal Cancel As Boolean)
(, 6) = (dex, 0)
Unload Me
End Sub
Private Sub ListBox3_DblClick(ByVal Cancel As Boolean)
(, 6) = (dex, 0)
Unload Me
End Sub
Private Sub ListBox4_DblClick(ByVal Cancel As Boolean)
云南农业大学
8
VBA代码全集
(, 6) = (dex, 0)
Unload Me
End Sub
Private Sub ListBox5_DblClick(ByVal Cancel As Boolean)
(, 6) = (dex, 0)
Unload Me
End Sub
见上图
5.插入用户窗体 右键点击userform2 worksheet dblclick
Private Sub ListBox1_DblClick(ByVal Cancel As Boolean)
(, 7) = (dex, 0)
Unload Me
End Sub
Userform initialize
Private Sub UserForm_Initialize()
Updating = False
With Sheets("初始化")
Sheets("科目表").Range("h2:i10000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("m2:m3"), CopyToRange:=.Range("n2"), Unique:=True
End With
Updating = True
End Sub
七．单位汇总（sumif），单条件汇总
=SUMIF(业务!$D$4:$D$1000,单位汇
总!$A15,业务!I$4:I$10000)
云南农业大学
9
VBA代码全集
云南农业大学
10
VBA代码全集
Sub 单位汇总1()
Updating = False
range("a1:i10000").Clear
Cells(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"), Unique:=True
Sheets("业务").Range("A3:J10000").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("G1:G2"), CopyToRange:=Range("G3:I3"), Unique:=False
Dim i As Long
Dim irow As Long
irow = Range("a3").End(xlDown).Row
For i = 4 To irow
Cells(i, 2) = (Range("g4:g10000"),
Range("h4:h10000"))
Cells(i, 3) = (Range("g4:g10000"),
Range("i4:i10000"))
Cells(i, 4) = (Cells(i, 2) - Cells(i, 3), 2)
Next i
Range("g1:i10000").Clear
Updating = True
End Sub
云南农业大学
Cells(i, 1),
Cells(i, 1),
11
VBA代码全集
八、多条件汇总 （连接、sumif）
连接=k4&l4&m4&n4
Vba：
Sub 多条件汇总()
Updating = False
Range("a1:p10000").Clear
Sheets("业务").Range("D3:G10000").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("B3:E3"), Unique:=True
Sheets("业务").Range("D3:I10000").AdvancedFilter Action:=xlFilterCopy, _
云南农业大学
12
VBA代码全集
CopyToRange:=Range("K3:P3"), Unique:=False
Dim j As Long
Dim jrow As Long
jrow = Range("k3").End(xlDown).Row
For j = 4 To jrow
Cells(j, 10) = Cells(j, 11) & Cells(j, 12) & Cells(j, 13) & Cells(j, 14)
Next j
Dim i As Long
Dim irow As Long
irow = Range("b3").End(xlDown).Row
For i = 4 To irow
Cells(3, 6) = "指标数"
Cells(3, 7) = "拨款数"
Cells(3, 8) = "余额"
Cells(i, 1) = Cells(i, 2) & Cells(i, 3) & Cells(i, 4) & Cells(i, 5)
Cells(i, 6) = (Range("j4:j10000"),
Range("o4:o10000"))
Cells(i, 7) = (Range("j4:j10000"),
Range("p4:p10000"))
Cells(i, 8) = (Cells(i, 6) - Cells(i, 7), 2)Next i
Range("i3:p10000").Clear
Range("a1:a10000").Delete
Updating = True
End Sub
云南农业大学
Cells(i, 1),
Cells(i, 1),
13
VBA代码全集
九、多条件汇总、ado
Sub 多条件汇总()
Updating = False
Dim i As Integer
Dim strsql As String
Dim cnn As New tion
Dim rst As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql = " SELECT 单位,类,款,项, sum(指标数) as 预算股指标,sum(拨款数) as 预算股拨款 from[业
务$a3:J10000] where 归口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP
BY 单位,类,款,项"
strsql, cnn
For i = 1 To
Sheets("多条件汇总").Cells(3, i) = (i - 1).Name
云南农业大学
14
VBA代码全集
Next i
Sheets("多条件汇总").Range("a4").CopyFromRecordset rst
Set rst = Nothing
Set cnn = Nothing
Updating = True
End Sub
十、对账
云南农业大学
15
VBA代码全集
Sub 预算股()
Updating = False
Dim i As Integer
Dim strsql1 As String
Dim cnn1 As New tion
Dim rst1 As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql1 = " SELECT 单位,类,款,项, sum(指标数) as 预算股指标 from[预算股$a3:m50000] where 归
口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项"
strsql1, cnn1
For i = 1 To
Sheets("对帐").Cells(3, i + 10) = (i - 1).Name
云南农业大学
16
VBA代码全集
Next i
Sheets("对帐").Range("k4").CopyFromRecordset rst1
Set rst1 = Nothing
Set cnn1 = Nothing
Dim strsql2 As String
Dim cnn2 As New tion
Dim rst2 As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql2 = " SELECT 单位,类,款,项, sum(指标数) as 专业股指标 from[专业股$a3:j50000] where 归
口='" & Range("h2").Value & "'and 月<=" & Range("i2").Value & " GROUP BY 单位,类,款,项"
strsql2, cnn2
For i = 1 To
Sheets("对帐").Cells(3, i + 19) = (i - 1).Name
Next i
Sheets("对帐").Range("t4").CopyFromRecordset rst2
Set rst2 = Nothing
Set cnn2 = Nothing
s = (Range("k4:k10000")) + 4
Range("T4:W10000").Select
Range("K" & s).Select
Range("X4:X10000").Select
云南农业大学
17
VBA代码全集
Range("P" & s).Select
Range("X3").Select
Range("P3").Select
Dim strsql As String
Dim cnn As New tion
Dim rst As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql = " SELECT 单位,类,款,项, sum(预算股指标) as 预算股指标 ,sum(专业股指标) as 专业股
指标 from[对帐$k3:p50000] GROUP BY 单位,类,款,项"
strsql, cnn
For i = 1 To
Sheets("对帐").Cells(3, i) = (i - 1).Name
Next i
Sheets("对帐").Range("a4").CopyFromRecordset rst
Set rst = Nothing
Set cnn = Nothing
Updating = True
End Sub
云南农业大学
18
VBA代码全集
十一、sql筛选
Sub 筛选()
Updating = False
Dim i As Integer
Dim strsql As String
Dim cnn As New tion
Dim rst As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql = " SELECT distinct 单位,类,款,项 from[专业$a3:h10000]"
strsql, cnn
For i = 1 To
Sheets("筛选").Cells(3, i) = (i - 1).Name
Next i
Sheets("筛选").Range("a4").CopyFromRecordset rst
云南农业大学
19
VBA代码全集
Set rst = Nothing
Set cnn = Nothing
Updating = True
End Sub
十二、sql连接、交叉汇总
云南农业大学
20
VBA代码全集
Sub 连接()
Updating = False
Dim i As Integer
Dim strsql As String
Dim cnn As New tion
Dim rst As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql = " SELECT 股,月,归口,单位,类,款,项,指标数 from [专业$a3:h10000] union ALL SELECT 股,
月,归口,单位,类,款,项,指标数 from [预算$a3:l10000] order by 股 desc"
strsql, cnn
For i = 1 To
Sheets("连接").Cells(1, i + 19) = (i - 1).Name
Next i
Sheets("连接").Range("t2").CopyFromRecordset rst
Set rst = Nothing
Set cnn = Nothing
Updating = True
End Sub
Sub 汇总()
Updating = False
云南农业大学
21
VBA代码全集
Call 连接
Dim i As Integer
Dim strsql As String
Dim cnn As New tion
Dim rst As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql = " transform sum(指标数) SELECT 单位,类,款,项 from [连接$t1:aa10000] where 归口= '"
& Range("h2").Value & "' and 月=" & Range("i2").Value & " group by 单位,类,款,项 pivot 股"
strsql, cnn
For i = 1 To
Sheets("连接").Cells(3, i) = (i - 1).Name
Next i
Sheets("连接").Range("a4").CopyFromRecordset rst
Set rst = Nothing
Set cnn = Nothing
Range("t1:aa10000").ClearContents
Updating = True
End Sub
十三、select语句总结
1、筛选（false ---筛选全部）
Select 列表名称1,列表名称2,…….列表名称n from [表$区域]
或者Select * from [表$区域]
2、筛选唯一的数据
Select distinct 列表名称1,列表名称2,…….列表名称n from [表$区域]
3、分类汇总
云南农业大学
22
VBA代码全集
Select 列表名称1,列表名称2,…….列表名称n，sum(a) as a from [表$区域]
Group by列表名称1,列表名称2,…….列表名称n
4、条件分类汇总
Select 列表名称1,列表名称2,…….列表名称n，sum(a) as a from [表$区域]
Where 归口=’”& range(“”).value &”’ and 月=”& range(“”).value &” Group by列表名
称1,列表名称2,…….列表名称n
5、交叉汇总
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
十四、报表（有层次）
连接
云南农业大学
23
VBA代码全集
Transform sum（指标数），pivot 股
按单位、类、款进行汇总
按单位、类进行汇总
按单位进行汇总
云南农业大学
24
VBA代码全集
连接以上四个表的内容，并按单位、类、款、项进行排序，其中单位按降序排序
1、整体写代码
Sub 报表()
Updating = False
Dim i As Integer
Dim strsql1 As String
Dim cnn1 As New tion
Dim rst1 As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql1 = " SELECT 股,月,归口,单位,类,款,项,sum(指标数) as 指标数 from[专业$a3:h10000]
group by 股,月,归口,单位,类,款,项 union all SELECT 股,月,归口,单位,类,款,项,sum(指标数) as
指标数 from[预算$a3:l10000] group by 股,月,归口,单位,类,款,项 order by 股 desc"
strsql1, cnn1
For i = 1 To
Sheets("报表").Cells(3, i + 9) = (i - 1).Name
Next i
Sheets("报表").Range("j4").CopyFromRecordset rst1
云南农业大学
25
VBA代码全集
Set rst1 = Nothing
Set cnn1 = Nothing
Dim strsql2 As String
Dim cnn2 As New tion
Dim rst2 As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql2 = "transform sum(指标数) SELECT 单位,类,款,项 from[报表$j3:q10000] where 归口='" &
Range("g2") _
.Value & "' and 月<=" & Range("h2").Value & " group by 单位,类,款,项 order by 单位 desc pivot
股 "
strsql2, cnn2
For i = 1 To
Sheets("报表").Cells(3, i + 19) = (i - 1).Name
Next i
Sheets("报表").Range("t4").CopyFromRecordset rst2
Set rst2 = Nothing
Set cnn2 = Nothing
Dim strsql3 As String
Dim cnn3 As New tion
Dim rst3 As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql3 = "SELECT 单位,类,款,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表
$t3:y10000] group by 单位,类,款 order by 单位 desc"
云南农业大学
26
VBA代码全集
strsql3, cnn3
For i = 1 To
Sheets("报表").Cells(3, i + 26) = (i - 1).Name
Next i
Sheets("报表").Range("aa4").CopyFromRecordset rst3
Set rst3 = Nothing
Set cnn3 = Nothing
Dim strsql4 As String
Dim cnn4 As New tion
Dim rst4 As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql4 = "SELECT 单位,类,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表$t3:y10000]
group by 单位,类 order by 单位 desc"
strsql4, cnn4
For i = 1 To
Sheets("报表").Cells(3, i + 32) = (i - 1).Name
Next i
Sheets("报表").Range("ag4").CopyFromRecordset rst4
Set rst4 = Nothing
Set cnn4 = Nothing
Dim strsql5 As String
Dim cnn5 As New tion
Dim rst5 As New set
云南农业大学
27
VBA代码全集
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql5 = "SELECT 单位,sum(专业股) as 专业股,sum(预算股) as 预算股 from[报表$t3:y10000]
group by 单位 order by 单位 desc"
strsql5, cnn5
For i = 1 To
Sheets("报表").Cells(3, i + 37) = (i - 1).Name
Next i
Sheets("报表").Range("al4").CopyFromRecordset rst5
Set rst5 = Nothing
Set cnn5 = Nothing
Columns("AD:AD").Select
Shift:=xlToRight
Range("ad3") = "项"
Columns("Aj:Ak").Select
Shift:=xlToRight
Range("aj3") = "款"
Range("ak3") = "项"
Columns("Ap:Ar").Select
Shift:=xlToRight
Range("ap3") = "类"
Range("aq3") = "款"
Range("ar3") = "项"
Dim strsql6 As String
云南农业大学
28
VBA代码全集
Dim cnn6 As New tion
Dim rst6 As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql6 = " SELECT 单位,类,款,项,专业股,预算股 from [报表$t3:y10000] union all SELECT 单
位,类,款,项,专业股,预算股 from [报表$aa3:af10000] union all SELECT 单位,类,款,项,专业股,
预算股 from [报表$ah3:am10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表
$ao3:at10000] order by 单位 desc,类,款,项 "
strsql6, cnn6
For i = 1 To
Sheets("报表").Cells(3, i) = (i - 1).Name
Next i
Sheets("报表").Range("a4").CopyFromRecordset rst6
Set rst6 = Nothing
Set cnn6 = Nothing
Range("j1:au10000").ClearContents
Dim p As Long
Dim prow As Long
prow = Range("a3").End(xlDown).Row
For p = 4 To prow
Range("g3") = "金额"
Cells(p, 7) = (Cells(p, 6) - Cells(p, 5), 2)
Next p
Updating = True
End Sub
2、分开写代码：
Sub 连接()
云南农业大学
29
VBA代码全集
Updating = False
Dim i As Integer
Dim strsql As String
Dim cnn As New tion
Dim rst As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql = " SELECT 月,归口,股,单位,类,款,项,sum(指标数) as 指标数 from[专业$a3:h10000] group
by 月,归口,股,单位,类,款,项 union all SELECT 月, 归口,股,单位,类,款,项,sum(指标数) as 指标
数 from[预算$a3:l10000] group by 月, 归口,股,单位,类,款,项 order by 股 desc"
strsql, cnn
For i = 1 To
Sheets("报表").Cells(3, i + 9) = (i - 1).Name
Next i
Sheets("报表").Range("j4").CopyFromRecordset rst
Set rst = Nothing
Set cnn = Nothing
Updating = True
End Sub
Sub 项()
Updating = False
Call 连接
Dim i As Integer
Dim strsql As String
Dim cnn As New tion
Dim rst As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
云南农业大学
30
VBA代码全集
Source=" & me
strsql = "transform sum(指标数) SELECT 单位,类,款,项 from [报表$j3:q10000] where 归口= '"
& Range("g2").Value & "' and 月<=" & Range("h2").Value & " group by 单位,类,款,项 pivot 股
"
strsql, cnn
For i = 1 To
Sheets("报表").Cells(3, i + 19) = (i - 1).Name
Next i
Sheets("报表").Range("t4").CopyFromRecordset rst
Set rst = Nothing
Set cnn = Nothing
Updating = True
End Sub
Sub 款()
Updating = False
Call 项
Dim i As Integer
Dim strsql As String
Dim cnn As New tion
Dim rst As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql = " SELECT 单位,类,款, sum(专业股) as 专业股, sum(预算股) as 预算股 from [报表
$t3:y10000] group by 单位,类,款 "
strsql, cnn
For i = 1 To
Sheets("报表").Cells(3, i + 26) = (i - 1).Name
云南农业大学
31
VBA代码全集
Next i
Sheets("报表").Range("aa4").CopyFromRecordset rst
Set rst = Nothing
Set cnn = Nothing
Columns("AD:AD").Select
Shift:=xlToRight
Cells(3, 30) = "项"
Updating = True
End Sub
Sub 类()
Updating = False
Call 款
Dim i As Integer
Dim strsql As String
Dim cnn As New tion
Dim rst As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql = " SELECT 单位,类, sum(专业股) as 专业股, sum(预算股) as 预算股 from [报表
$aa3:af10000] group by 单位,类 "
strsql, cnn
For i = 1 To
Sheets("报表").Cells(3, i + 33) = (i - 1).Name
Next i
Sheets("报表").Range("ah4").CopyFromRecordset rst
云南农业大学
32
VBA代码全集
Set rst = Nothing
Set cnn = Nothing
Columns("AJ:AJ").Select
Shift:=xlToRight
Columns("AK:AK").Select
Shift:=xlToRight
Range("AJ3").Select
aR1C1 = "款"
Range("AK3").Select
aR1C1 = "项"
Updating = True
End Sub
Sub 单位()
Updating = False
Call 类
Dim i As Integer
Dim strsql As String
Dim cnn As New tion
Dim rst As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql = " SELECT 单位, sum(专业股) as 专业股, sum(预算股) as 预算股 from [报表$ah3:am10000]
group by 单位 "
strsql, cnn
For i = 1 To
Sheets("报表").Cells(3, i + 40) = (i - 1).Name
Next i
Sheets("报表").Range("ao4").CopyFromRecordset rst
云南农业大学
33
VBA代码全集
Set rst = Nothing
Set cnn = Nothing
Updating = True
Columns("AP:AP").Select
Shift:=xlToRight
Columns("AQ:AQ").Select
Shift:=xlToRight
Columns("AR:AR").Select
Shift:=xlToRight
Range("AP3").Select
aR1C1 = "类"
Range("AQ3").Select
aR1C1 = "款"
Range("AR3").Select
aR1C1 = "项"
End Sub
Sub 报表()
If Range("i2") = "类" Then
Call 类
ElseIf Range("i2") = "款" Then
Call 款
Else
Call 项
End If
End Sub
Sub 总报表()
Updating = False
云南农业大学
34
VBA代码全集
Call 单位
Dim i As Integer
Dim strsql As String
Dim cnn As New tion
Dim rst As New set
"Provider=.4.0;Extended Properties='Excel 8.0;Hdr=Yes';Data
Source=" & me
strsql = " SELECT 单位,类,款,项,专业股,预算股 from [报表$t3:y10000] union all SELECT 单位,
类,款,项,专业股,预算股 from [报表$aa3:af10000] union all SELECT 单位,类,款,项,专业股,预算
股 from [报表$ah3:am10000] union all SELECT 单位,类,款,项,专业股,预算股 from [报表
$ao3:at10000] order by 单位 desc,类,款,项 "
strsql, cnn
For i = 1 To
Sheets("报表").Cells(3, i) = (i - 1).Name
Next i
Sheets("报表").Range("a4").CopyFromRecordset rst
Set rst = Nothing
Set cnn = Nothing
Range("j1:br10000").Clear
Updating = True
End Sub
云南农业大学
35
版权声明：本文标题：VBA代码全集 内容由热心网友自发贡献，该文观点仅代表作者本人， 转载请联系作者并注明出处：https://m.elefans.com/dianzi/1719553183a784650.html， 本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容，一经查实，本站将立刻删除。
发表评论