《VBA代码全集模板》由会员分享，可在线阅读，更多相关《VBA代码全集模板（38页珍藏版）》请在金锄头文库上搜索。
1、VBA代码全集目 录一、引用2二、Worksheet_Change 事件：2三、相乘4四、相减5五、高级筛选5六、双击事件7七单位汇（mif），单条件汇9八、多条件汇 （连接、mif）12九、多条件汇、ado14十、对账15十一、sql筛选19十二、sql连接、交叉汇20十三、select语句结22十四、报表（有层次）2338云南农业大学一、引用相对引用B4绝对引用$B$4混合引用$B4、B$4 F4进行引用切换，$在字母前面则锁定列，在数字前面则锁定行。二、Worksheet_Change 事件：1.在单元格中C4=VLOOKUP(B4,简码表!$B$4:$C$1000,2,FALSE)2.
2、 Worksheet_Change事件代码：Private b Worksheet_Change(ByVal Target As Range)On error reme 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 b备查代码：Private b Worksheet_Change(ByVal Target As Range)On Error Reme 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(Cells(i,
4、5), Sheets(类款项).Range(b2:e2000), 3, False)Cells(i, 8) = Application.WorksheetFunction.VLookup(Cells(i, 5), Sheets(类款项).Range(b2:e2000), 4, False)End IfEnd b三、相乘b 计算金额()Application.ScreenUpdating = FalseDim i As LongDim irow As Longirow = Range(a3).End(xldown).Row计算3行以下的内容For i = 4 To irowCells(i, 3)
5、 = Cells(i, 1) * Cells(i, 2)Next i继续运行下一个结果Application.ScreenUpdating = TrueEnd b四、相减b 相减()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) = VBA.Round(Ce
6、lls(i, 1) - Cells(i, 2), 2当基数为非整数时，结果保留到小数点后两位)Next iApplication.ScreenUpdating = TrueEnd b五、高级筛选 （工具-宏-录制新宏，宏名改成高级筛选）b 高级筛选() Sheets(业务).Range(A3:I10000)列表区域.AdvancedFilter Action:=xlFilterCopy, _ CopyToRange:=ActiveCell.Range(A1:B1)复制区域, Unique:=True筛选结果是唯一的End b六、双击事件1.插入-名称-定义（修改名称和引用位置）2查看代码-插入
7、-用户窗体 工具箱-多页、列表框-右键属性点击page1修改caption为资产类-点击空白列表框修改rowsource为box1依次类推3. 业务表-查看代码 Worksheet beforedoubleclickPrivate b Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Target.Row 3 And Target.Column = 6 ThenUserForm1.ShowSheets(初始化).Range(m3) = ActiveCell活动单元格内容显示工作表“初始化”的单元格m3
8、中ElseIf Target.Row 3 And Target.Column = 7 ThenUserForm2.ShowEnd IfEnd b备查代码：Private b 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 Target.Column = 7 ThenUserForm
9、2.ShowSheets(初始化).Range(f2) = ActiveCellElseIf Target.Row 3 And Target.Column = 8 ThenUserForm3.ShowEnd IfEnd b4右键点击Userform1查看代码 Listbox1 dbclickPrivate b ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox1.ListIndex, 0)Unload MeEnd
10、bPrivate b ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox2.ListIndex, 0)Unload MeEnd bPrivate b ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox3.ListIndex, 0)Unl
11、oad MeEnd bPrivate b ListBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox4.ListIndex, 0)Unload MeEnd bPrivate b ListBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 6) = ListBox1.List(ListBox5.ListIn
12、dex, 0)Unload MeEnd b见上图5.插入用户窗体 右键点击userform2 worksheet dblclick Private b ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row, 7) = ListBox1.List(ListBox1.ListIndex, 0)Unload MeEnd bUserform initializePrivate b UserForm_Initialize()Application.ScreenUpdating =
13、FalseWith Sheets(初始化)Sheets(科目表).Range(h2:i10000).AdvancedFilter Action:=xlFilterCopy, _CriteriaRange:=.Range(m2:m3), CopyToRange:=.Range(n2), Unique:=TrueEnd WithApplication.ScreenUpdating = TrueEnd b七单位汇（mif），单条件汇=MIF(业务!$D$4:$D$1000,单位汇!$A15,业务!I$4:I$10000)b 单位汇1()Application.ScreenUpdating = Fal
14、serange(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), Unique:=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.mI
