VBA代码全集模板.docx
- 文档编号:23850162
- 上传时间:2023-05-21
- 格式:DOCX
- 页数:39
- 大小:736.41KB
VBA代码全集模板.docx
《VBA代码全集模板.docx》由会员分享,可在线阅读,更多相关《VBA代码全集模板.docx(39页珍藏版)》请在冰豆网上搜索。
VBA代码全集模板
一、引用
相对引用B4
绝对引用$B$4
混合引用$B4、B$4
F4进行引用切换,$在字母前面则锁定列,在数字前面则锁定行。
二、Worksheet_Change事件:
1.在单元格中C4=VLOOKUP(B4,简码表!
$B$4:
$C$1000,2,FALSE)
2.Worksheet_Change事件代码:
PrivateSubWorksheet_Change(ByValTargetAsRange)
Onerrorresumenext
IfTarget.Row>3AndTarget.Column=2Then
i=Target.Row
Cells(i,3)=Application.WorksheetFunction.VLookup(Cells(i,2),Sheets("简码表").Range("b4:
c100"),2,False)
EndIf
EndSub
备查代码:
PrivateSubWorksheet_Change(ByValTargetAsRange)
OnErrorResumeNext
IfTarget.Row>3AndTarget.Column=5Then
i=Target.Row
Cells(i,6)=Application.WorksheetFunction.VLookup(Cells(i,5),Sheets("类款项").Range("b2:
e2000"),2,False)
Cells(i,7)=Application.WorksheetFunction.VLookup(Cells(i,5),Sheets("类款项").Range("b2:
e2000"),3,False)
Cells(i,8)=Application.WorksheetFunction.VLookup(Cells(i,5),Sheets("类款项").Range("b2:
e2000"),4,False)
EndIf
EndSub
三、相乘
Sub计算金额()
Application.ScreenUpdating=False
DimiAsLong
DimirowAsLong
irow=Range("a3").End(xldown).Row
Fori=4Toirow
Cells(i,3)=Cells(i,1)*Cells(i,2)
Nexti
Application.ScreenUpdating=True
EndSub
四、相减
Sub相减()
Application.ScreenUpdating=False
Range("c3:
c10000").ClearContents
DimiAsLong
DimirowAsLong
irow=Range("a5000").End(xlUp).Row
Fori=3Toirow
Cells(i,3)=VBA.Round((Cells(i,1)-Cells(i,2)),2)
Nexti
Application.ScreenUpdating=True
EndSub
五、高级筛选(工具-宏-录制新宏,宏名改成高级筛选)
Sub高级筛选()
Sheets("业务").Range("A3:
I10000").AdvancedFilterAction:
=xlFilterCopy,_
CopyToRange:
=ActiveCell.Range("A1:
B1"),Unique:
=True
EndSub
六、双击事件
1.插入-名称-定义(修改名称和引用位置)
2.查看代码-插入-用户窗体
工具箱-多页、列表框-右键属性
点击page1修改caption为资产类-点击空白列表框修改rowsource为box1
依次类推
3.业务表-查看代码Worksheetbeforedoubleclick
PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)
IfTarget.Row>3AndTarget.Column=6Then
UserForm1.Show
Sheets("初始化").Range("m3")=ActiveCell
ElseIfTarget.Row>3AndTarget.Column=7Then
UserForm2.Show
EndIf
EndSub
备查代码:
PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)
IfTarget.Row>3AndTarget.Column=6Then
UserForm1.Show
Sheets("初始化").Range("c2")=ActiveCell
ElseIfTarget.Row>3AndTarget.Column=7Then
UserForm2.Show
Sheets("初始化").Range("f2")=ActiveCell
ElseIfTarget.Row>3AndTarget.Column=8Then
UserForm3.Show
EndIf
EndSub
4.右键点击Userform1查看代码Listbox1dbclick
PrivateSubListBox1_DblClick(ByValCancelAsMSForms.ReturnBoolean)
ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox1.ListIndex,0)
UnloadMe
EndSub
PrivateSubListBox2_DblClick(ByValCancelAsMSForms.ReturnBoolean)
ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox2.ListIndex,0)
UnloadMe
EndSub
PrivateSubListBox3_DblClick(ByValCancelAsMSForms.ReturnBoolean)
ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox3.ListIndex,0)
UnloadMe
EndSub
PrivateSubListBox4_DblClick(ByValCancelAsMSForms.ReturnBoolean)
ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox4.ListIndex,0)
UnloadMe
EndSub
PrivateSubListBox5_DblClick(ByValCancelAsMSForms.ReturnBoolean)
ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox5.ListIndex,0)
UnloadMe
EndSub
见上图
5.插入用户窗体右键点击userform2worksheetdblclick
PrivateSubListBox1_DblClick(ByValCancelAsMSForms.ReturnBoolean)
ActiveSheet.Cells(ActiveCell.Row,7)=ListBox1.List(ListBox1.ListIndex,0)
UnloadMe
EndSub
Userforminitialize
PrivateSubUserForm_Initialize()
Application.ScreenUpdating=False
WithSheets("初始化")
Sheets("科目表").Range("h2:
i10000").AdvancedFilterAction:
=xlFilterCopy,_
CriteriaRange:
=.Range("m2:
m3"),CopyToRange:
=.Range("n2"),Unique:
=True
EndWith
Application.ScreenUpdating=True
EndSub
七.单位汇总(sumif),单条件汇总=SUMIF(业务!
$D$4:
$D$1000,单位汇总!
$A15,业务!
I$4:
I$10000)
Sub单位汇总1()
Application.ScreenUpdating=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").AdvancedFilterAction:
=xlFilterCopy,_
CopyToRange:
=Range("A3"),Unique:
=True
Sheets("业务").Range("A3:
J10000").AdvancedFilterAction:
=xlFilterCopy,_
CriteriaRange:
=Range("G1:
G2"),CopyToRange:
=Range("G3:
I3"),Unique:
=False
DimiAsLong
DimirowAsLong
irow=Range("a3").End(xlDown).Row
Fori=4Toirow
Cells(i,2)=Application.WorksheetFunction.SumIf(Range("g4:
g10000"),Cells(i,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)
Nexti
Range("g1:
i10000").Clear
Application.ScreenUpdating=True
EndSub
八、多条件汇总(连接、sumif)
连接=k4&l4&m4&n4
Vba:
Sub多条件汇总()
Application.ScreenUpdating=False
Range("a1:
p10000").Clear
Sheets("业务").Range("D3:
G10000").AdvancedFilterAction:
=xlFilterCopy,_
CopyToRange:
=Range("B3:
E3"),Unique:
=True
Sheets("业务").Range("D3:
I10000").AdvancedFilterAction:
=xlFilterCopy,_
CopyToRange:
=Range("K3:
P3"),Unique:
=False
DimjAsLong
DimjrowAsLong
jrow=Range("k3").End(xlDown).Row
Forj=4Tojrow
Cells(j,10)=Cells(j,11)&Cells(j,12)&Cells(j,13)&Cells(j,14)
Nextj
DimiAsLong
DimirowAsLong
irow=Range("b3").End(xlDown).Row
Fori=4Toirow
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)=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)Nexti
Range("i3:
p10000").Clear
Range("a1:
a10000").Delete
Application.ScreenUpdating=True
EndSub
九、多条件汇总、ado
Sub多条件汇总()
Application.ScreenUpdating=False
DimiAsInteger
DimstrsqlAsString
DimcnnAsNewADODB.Connection
DimrstAsNewADODB.Recordset
cnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;ExtendedProperties='Excel8.0;Hdr=Yes';DataSource="&ThisWorkbook.FullName
strsql="SELECT单位,类,款,项,sum(指标数)as预算股指标,sum(拨款数)as预算股拨款from[业务$a3:
J10000]where归口='"&Range("h2").Value&"'and月<="&Range("i2").Value&"GROUPBY单位,类,款,项"
rst.Openstrsql,cnn
Fori=1Torst.Fields.Count
Sheets("多条件汇总").Cells(3,i)=rst.Fields(i-1).Name
Nexti
Sheets("多条件汇总").Range("a4").CopyFromRecordsetrst
rst.Close
cnn.Close
Setrst=Nothing
Setcnn=Nothing
Application.ScreenUpdating=True
EndSub
十、对账
Sub预算股()
Application.ScreenUpdating=False
DimiAsInteger
Dimstrsql1AsString
Dimcnn1AsNewADODB.Connection
Dimrst1AsNewADODB.Recordset
cnn1.Open"Provider=Microsoft.Jet.OLEDB.4.0;ExtendedProperties='Excel8.0;Hdr=Yes';DataSource="&ThisWorkbook.FullName
strsql1="SELECT单位,类,款,项,sum(指标数)as预算股指标from[预算股$a3:
m50000]where归口='"&Range("h2").Value&"'and月<="&Range("i2").Value&"GROUPBY单位,类,款,项"
rst1.Openstrsql1,cnn1
Fori=1Torst1.Fields.Count
Sheets("对帐").Cells(3,i+10)=rst1.Fields(i-1).Name
Nexti
Sheets("对帐").Range("k4").CopyFromRecordsetrst1
rst1.Close
cnn1.Close
Setrst1=Nothing
Setcnn1=Nothing
Dimstrsql2AsString
Dimcnn2AsNewADODB.Connection
Dimrst2AsNewADODB.Recordset
cnn2.Open"Provider=Microsoft.Jet.OLEDB.4.0;ExtendedProperties='Excel8.0;Hdr=Yes';DataSource="&ThisWorkbook.FullName
strsql2="SELECT单位,类,款,项,sum(指标数)as专业股指标from[专业股$a3:
j50000]where归口='"&Range("h2").Value&"'and月<="&Range("i2").Value&"GROUPBY单位,类,款,项"
rst2.Openstrsql2,cnn2
Fori=1Torst2.Fields.Count
Sheets("对帐").Cells(3,i+19)=rst2.Fields(i-1).Name
Nexti
Sheets("对帐").Range("t4").CopyFromRecordsetrst2
rst2.Close
cnn2.Close
Setrst2=Nothing
Setcnn2=Nothing
s=Application.WorksheetFunction.CountA(Range("k4:
k10000"))+4
Range("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
DimstrsqlAsString
DimcnnAsNewADODB.Connection
DimrstAsNewADODB.Recordset
cnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;ExtendedProperties='Excel8.0;Hdr=Yes';DataSource="&ThisWorkbook.FullName
strsql="SELECT单位,类,款,项,sum(预算股指标)as预算股指标,sum(专业股指标)as专业股指标from[对帐$k3:
p50000]GROUPBY单位,类,款,项"
rst.Openstrsql,cnn
Fori=1Torst.Fields.Count
Sheets("对帐").Cells(3,i)=rst.Fields(i-1).Name
Nexti
Sheets("对帐").Range("a4").CopyFromRecordsetrst
rst.Close
cnn.Close
Setrst=Nothing
Setcnn=Nothing
Application.ScreenUpdating=True
EndSub
十一、sql筛选
Sub筛选()
Application.ScreenUpdating=False
DimiAsInteger
DimstrsqlAsString
DimcnnAsNewADODB.Connection
DimrstAsNewADODB.Recordset
cnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;ExtendedProperties='Excel8.0;Hdr=Yes';DataSource="&ThisWorkbook.FullName
strsql="SELECTdistinct单位,类,款,项from[专业$a3:
h10000]"
rst.Openstrsql,cnn
Fori=1Torst.Fields.Count
Sheets("筛选").Cells(3,i)=rst.Fields(i-1).Name
Nexti
Sheets("筛选").Range("a4").CopyFromRecordsetrst
rst.Close
cnn.Close
Setrst=Nothing
Setcnn=Nothing
Application.ScreenUpdating=True
EndSub
十二、sql连接、交叉汇总
Sub连接()
Application.ScreenUpdating=False
DimiAsInteger
DimstrsqlAsString
DimcnnAsNewADODB.Connection
DimrstAsNewADODB.Recordset
cnn.Open"Provider=Microsoft.Jet.OLEDB.4.0;ExtendedProperties='Excel8.0;Hdr=Yes';DataSource="&ThisWorkbook.FullName
strsql="SELECT股,月,归口,单位,类,款,项,指标数from[专业$a3:
h10000]unionALLSELECT股,月,归口,单位,类,款,项,指标数from[预算$a3:
l10000]orderby股desc"
rst.Openstrsql,cnn
Fori=1Torst.Fields.Count
Sheets("
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- VBA 代码 全集 模板
![提示](https://static.bdocx.com/images/bang_tan.gif)