VBA代码全集

VBA代码全集云南农业大学1VBA代码全集云南农业大学2目录一、引用..................................................................3二、Worksheet_Change事件：...........................................3三、相乘..................................................................5四、相减..................................................................6五、高级筛选............................................................6六、双击事件............................................................8七．单位汇总（sumif），单条件汇总..............................10八、多条件汇总（连接、sumif）..................................13九、多条件汇总、ado..................................................15十、对账.................................................................16十一、sql筛选..........................................................20十二、sql连接、交叉汇总............................................21十三、select语句总结.................................................23十四、报表（有层次）...............................................24VBA代码全集云南农业大学3一、引用相对引用B4绝对引用$B$4混合引用$B4、B$4F4进行引用切换，$在字母前面则锁定列，在数字前面则锁定行。二、Worksheet_Change事件：1.在单元格中C4=VLOOKUP(B4,简码表!$B$4:$C$1000,2,FALSE)2.Worksheet_Change事件代码：PrivateSubWorksheet_Change(ByValTargetAsRange)OnerrorresumenextIfTarget.Row3AndTarget.Column=2Theni=Target.RowCells(i,3)=Application.WorksheetFunction.VLookup(Cells(i,2),Sheets(简码表VBA代码全集云南农业大学4).Range(b4:c100),2,False)EndIfEndSub备查代码：PrivateSubWorksheet_Change(ByValTargetAsRange)OnErrorResumeNextIfTarget.Row3AndTarget.Column=5Theni=Target.RowCells(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,VBA代码全集云南农业大学5False)Cells(i,8)=Application.WorksheetFunction.VLookup(Cells(i,5),Sheets(类款项).Range(b2:e2000),4,False)EndIfEndSub三、相乘Sub计算金额()Application.ScreenUpdating=FalseDimiAsLongDimirowAsLongirow=Range(a3).End(xldown).RowFori=4ToirowCells(i,3)=Cells(i,1)*Cells(i,2)NextiApplication.ScreenUpdating=TrueEndSubVBA代码全集云南农业大学6四、相减Sub相减()Application.ScreenUpdating=FalseRange(c3:c10000).ClearContentsDimiAsLongDimirowAsLongirow=Range(a5000).End(xlUp).RowFori=3ToirowCells(i,3)=VBA.Round((Cells(i,1)-Cells(i,2)),2)NextiApplication.ScreenUpdating=TrueEndSub五、高级筛选（工具-宏-录制新宏，宏名改成高级筛选）VBA代码全集云南农业大学7Sub高级筛选()Sheets(业务).Range(A3:I10000).AdvancedFilterAction:=xlFilterCopy,_CopyToRange:=ActiveCell.Range(A1:B1),Unique:=TrueEndSubVBA代码全集云南农业大学8六、双击事件1.插入-名称-定义（修改名称和引用位置）2．查看代码-插入-用户窗体工具箱-多页、列表框-右键属性点击page1修改caption为资产类-点击空白列表框修改rowsource为box1依次类推3.业务表-查看代码WorksheetbeforedoubleclickPrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfTarget.Row3AndTarget.Column=6ThenUserForm1.ShowSheets(初始化).Range(m3)=ActiveCellVBA代码全集云南农业大学9ElseIfTarget.Row3AndTarget.Column=7ThenUserForm2.ShowEndIfEndSub备查代码：PrivateSubWorksheet_BeforeDoubleClick(ByValTargetAsRange,CancelAsBoolean)IfTarget.Row3AndTarget.Column=6ThenUserForm1.ShowSheets(初始化).Range(c2)=ActiveCellElseIfTarget.Row3AndTarget.Column=7ThenUserForm2.ShowSheets(初始化).Range(f2)=ActiveCellElseIfTarget.Row3AndTarget.Column=8ThenUserForm3.ShowEndIfEndSub4．右键点击Userform1查看代码Listbox1dbclickPrivateSubListBox1_DblClick(ByValCancelAsMSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox1.ListIndex,0)UnloadMeEndSubPrivateSubListBox2_DblClick(ByValCancelAsMSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox2.ListIndex,0)UnloadMeEndSubPrivateSubListBox3_DblClick(ByValCancelAsMSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox3.ListIndex,0)UnloadMeEndSubPrivateSubListBox4_DblClick(ByValCancelAsMSForms.ReturnBoolean)VBA代码全集云南农业大学10ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox4.ListIndex,0)UnloadMeEndSubPrivateSubListBox5_DblClick(ByValCancelAsMSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row,6)=ListBox1.List(ListBox5.ListIndex,0)UnloadMeEndSub见上图5.插入用户窗体右键点击userform2worksheetdblclickPrivateSubListBox1_DblClick(ByValCancelAsMSForms.ReturnBoolean)ActiveSheet.Cells(ActiveCell.Row,7)=ListBox1.List(ListBox1.ListIndex,0)UnloadMeEndSubUserforminitializePrivateSubUserForm_Initialize()Application.ScreenUpdating=FalseWithSheets(初始化)Sheets(科目表).Range(h2:i10000).AdvancedFilterAction:=xlFilterCopy,_CriteriaRange:=.Range(m2:m3),CopyToRange:=.Range(n2),Unique:=TrueEndWithApplication.ScreenUpdating=TrueEndSub七．单位汇总（sumif），单条件汇总=SUMIF(业务!$D$4:$D$1000,单位汇总!$A15,业务!I$4:I$10000)VBA代码全集云南农业大学11VBA代码全集云南农业大学12Sub单位汇总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).AdvancedFilterAction:=xlFilterCopy,_CopyToRange:=Range(A3),Unique:=TrueSheets(业务).Range(A3:J10000).AdvancedFilterAction:=xlFilterCopy,_CriteriaRange:=Range(G1:G2),CopyToRange:=Range(G3:I3),Unique:=FalseDimiAsLongDimirowAsLongirow=Range(a3).End(xlDown).RowFori=4ToirowCells(i,2)=Application.WorksheetFunction.SumIf(Range(g4:g10000),Cells(i,1),Range(h4:h10000))Cells(i,3)=Application.WorksheetFunction.SumIf(Range(g4:g10000)