代码常用的VBA短句带注释

-.z.常用的VBA短句（带注释）[A65536].End(*lUp).Row'A列末行向上第一个有值的行数[A1].End(*lDown).Row'A列首行向下第一个有值之行数[IV1].End(*lToLeft).Column'第一行末列向左第一列有数值之列数。[A1].End(*lToRight).Column'第一行首列向右有连续值的末列之列数Application.mandBars("Standard").Controls(2).BeginGroup=True'在常用工具栏的第二个按钮前插入分隔符Cells.WrapTe*t=False'取消自动换行IfLen(Target)>5Then'如果当前单元格中的字符数超过5个,执行下一行Target.WrapTe*t=True'自动换行EndIf[A1:B10].SpecialCells(*lCellTypeBlanks).Rows.Hidden=True'有空格即隐藏行[A2].Parent.Name'返回活动单元格的工作表名[A2].Parent.Parent.Name'返回活动单元格的工作簿名勾选"VBA项目的信任"Application.SendKeys"%(tmstv){ENTER}"'在E*cel窗口操作Application.SendKeys"%(qtmstv){ENTER}"'在VBE窗口操作Application.mandBars("命令按钮名称").Position=msoBarFloating'使[命令按钮]悬浮在表格中Application.mandBars("命令按钮名称").Position=msoBarTop'使[命令按钮]排列在工具栏中ActiveSheet.ProtectPassword:="wshzw"'为工作表保护加口令ActiveSheet.UnprotectPassword:="wshzw"'解除工作表保护ActiveSheet.ProtectContents'判断工作表是否处于保护状态Application.DisplayAlerts=False'屏蔽确认提示ActiveCell.CurrentRegion.Select'选择与活动单元格相连的区域Range("a2:a20").NumberFormatLocal="00-00"'区域的格式化ActiveSheet.Cells.SpecialCells(*lCellTypeLastCell).Row'已用区域的最末行ActiveSheet.CopyBefore:=Sheets(1)'复制活动工作表到第一工作表之前Range("a2:a20").FormulaHidden=True'工作表处于保护状态时隐藏部分单元格公式Application.AskToUpdateLinks=False'不询问是否更新,并自动更新ActiveSheet.Hyperlinks.Delete'删除活动工作表超ActiveWorkbook.SaveLinkValues=False'不保存活动工作簿的外部值ActiveSheet.PageSetup.CenterFooter=Range("k2").Value'打印时设置自定义页脚ActiveSheet.PageSetup.Orientation=*lLandscape'设置为横向打印ActiveSheet.PageSetup.Orientation=*lPortrait'设置为纵向打印Application.WindowState=*lMinimized'最小化窗口Application.WindowState=*lNormal'最大化窗口ActiveWorkbook.FullName'当前窗口文件名与路径Application.AltStartupPath="E:\My\MyStart"'替补启动目录路径Application.AutoRecover.Path'返回/设置E*cel存储"自动恢复"临时文件的完整路径Application.DefaultFilePath'选项>常规中的默认工作目录Application.Evaluate("=INFO(""directory"")")'默认工作目录Application.LibraryPath'返回库文件夹的路径Application.NetworkTemplatesPath'返回保存模板的网络路径Application.Path'返回应用程序完整路径Application.RecentFiles.Item(1).Path'返回最近使用的*个文件路径,Item(1)=第一个文件Application.StartupPath'E*cel启动文件夹的路径Application.TemplatesPath'返回模板所存储的本地路径Application.UserLibraryPath'返回用户计算机上加载宏的安装路径Debug.PrintApplication.PathSeparator'路径分隔符"\"CurDir'默认工作目录E*cel.Parent.DefaultFilePath'默认工作目录ThisWorkbook.Path'返回当前工作薄的路径ActiveCell.Offset(,-1).Name="hzw"'定义名称ActiveCell.Precedents.Address'被当前单元格所引用的区域地址ActiveCell.Resize(0,2).Select'选定当前单元格并向右延伸二格ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(*lCellTypeVisible).Count-1'显示自动筛选后的行数Workbooks.Close'关闭所有工作簿Application.Quit'关闭所有工作簿Application.ScreenUpdating=False'Application.ScreenUpdating=True'冻结屏幕以加快程序运行Application.EnableEvents=False'Application.EnableEvents=True'抑制事件连锁执行Application.EnableEvents=FalseActiveWorkbook.Save'抑制BeforeSave事件的发生Application.EnableEvents=True'抑制指定事件FileDateTime("E:\MyDocuments\33.*ls")或FileDateTime(ThisWorkbook.FullName)'文件被创建或最后修改后的日期和时间FileLen(ThisWorkbook.FullName)/1024或FileLen("E:\MyDocuments\temp\33.*ls")/1024'文件的长度(大小),单位是KBDimmm(2,10)Range("a1:b10")=mm'可以将二维数组赋值给RangeApplication.Dialogs(*lDialogSaveAs).Show'显示保存对话框T=Application.GetOpenFilename("Te*tFiles(*.dat),*.dat")'选择文件打开路径'如下代码可使工作簿打开后30秒(或闲置30秒)不输入、不重新选择等,自动关闭工作簿PrivateSubWorkbook_Open()'工作簿打开事件tt'工作簿打开时启动tt过程EndSubPrivateSubWorkbook_SheetChange(ByValShAsObject,ByValTargetAsRange)'工作表变化事件tt'工作表中任一单元格有变化时启动tt过程EndSubPrivateSubWorkbook_SheetSelectionChange(ByValShAsObject,ByValTargetAsRange)'工作表选择变化事件tt'工作表中单元格的选择有变化时启动tt过程EndSubSubtt()'tt过程DimmyNowAsDate,BLAsInteger'定义myNow为日期型;定义BL为长整型myNow=Now'把当前的时间赋给变量myNowDo'开始循环语句DoBL=Second(Now)-Second(myNow)'循环中不断检查变量BL的值IfBL=30ThenGoToCl'当BL=30即跳转到CLDoEvents'转让控制权,以便sheets可继续操作LoopUntilBL>30'当BL>30即跳出循环E*itSubCl:Application.EnableEvents=False'避免引起其他事件ActiveWorkbook.CloseTrue'关闭活动工作簿并保存Application.EnableEvents=True'可触发其他事件EndSubRange("e4").Addment.Te*t"代头"&Chr(10)&"容……"'添加批注Range("e4").ment.Visible=True'显示批注把工作簿中所有工作表的指定列调整为最佳列宽:Sub调整列宽()Dimi%Fori=1ToSheets.Count'遍历工作簿中所有的工作表Sheets(i).Columns("A:K").AutoFit'把每个工作表的[A:K]列调整为最佳列宽Ne*tiEndSubDo循环语句的几种形式:'1.DoWhilei>1'条件为True时执行'......'要执行的语句Loop'2.DoUntili>1'条件为False时执行'......'要执行的语句Loop'3.Do'......'要执行的语句LoopWhilei>1'条件为True时执行'4.Do'......'要执行的语句LoopUntili>1'条件为False时执行'5.While...Wend语句Whilei>1'条件为True时执行'......'要执行的语句Wend工作表的复制与命名Subwshzw()DimiAsIntegerFori=1To5Sheets("Sheet1").CopyAfter:=Sheets(1)'Before/After复制新表在Sheets("Sheet1")前/后ActiveSheet.Name=i&"月"'为复制的新表命名Ne*tiSheets("Sheet1").Name="总表"'为Sheets("Sheet1")改名EndSubSub删除工作表()Application.DisplayAlerts=FalseSheet1.DeleteApplication.DisplayAlerts=TrueEndSubSub添加工作表()Fori=1To5Worksheets.Add.Name=iNe*tEndSub[A1:A20].AdvancedFilter*lFilterCopy,[B1],Unique:=True'可去掉重复数据[A2:C32].ReplaceWhat:="F",Replacement:="G"'指定围的查找与替换ActiveSheet.AutoFilterMode=False'取消自动筛选'执行以下语句可有效缩小工作簿的大小，执行前请先看清每条语句的作用:ActiveSheet.UsedRange.Clearments'清除活动工作表已使用围所有批注ActiveSheet.UsedRange.ClearFormats'清除活动工作表已使用围所有格式ActiveSheet.UsedRange.Validation.Delete'取消活动工作表已使用围的数据有效性ActiveSheet.Hyperlinks.Delete'删除活动工作表超ActiveSheet.DrawingObjects.Delete'删除活动工作表已使用围的所有对象ActiveSheet.UsedRange=ActiveSheet.UsedRange.Value'取消活动工作表已使用围的公式并保留值还有:Sub*()DimmyRangeAsStringmyRange=ActiveSheet.UsedRange.Address'去除活动工作表无数据的行列EndSub'这相当于把新的已使用区域赋值给变量，效果等同于手工删除多余的列或行后立即保存;来一个函数的PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)'右边单元格反向显示活动单元格文本IfActiveCell.Column<256ThenActiveCell.Offset(0,1)=StrReverse(ActiveCell)EndSubSubtest()DimmyRangeAsStringDebug.Print"LastRow="&Cells.SpecialCells(*lCellTypeLastCell).RowDebug.Print"LastColumn="&Cells.SpecialCells(*lCellTypeLastCell).ColumnmyRange=""EndSub如上下相邻单元格数据相同则删除一个SubYjue()DimmyCellAsRange,NCellAsRange'定义SetmyCell=ActiveSheet.Range("b2")'把对象ActiveSheet.Range("b2")赋给变量myCellDoWhileNotIsEmpty(myCell)'条件为True时执行SetNCell=myCell.Offset(1,0)'把对象myCell的下一个单元格赋给变量NCellIfNCell.Value=myCell.ValueThen'如上下相邻单元格数据相同,则望下执行myCell.Delete'删除myCellEndIf'结束条件语句SetmyCell=NCell'把变量NCell赋给变量myCell,等于在循环中把原myCell下移了一格LoopEndSub复制行高列宽与容:SubYjue()'过程的名称Sheet2.Rows("2:23").Copy'复制行区域Sheet3.Select'选择粘贴区域Range("A2").PasteSpecialPaste:=*lPasteColumnWidths'粘贴类型ActiveSheet.Paste'实施粘贴Application.CutCopyMode=False'取消复制模式EndSub如整行为空白则删除整行:SubDelRow()DimiAsInteger,LastRowAsIntegerLastRow=ActiveSheet.Cells.SpecialCells(*lCellTypeLastCell).Row'把最后行的行号赋给变量Fori=LastRowTo1Step-1'倒循环IfRange("iv"&i).End(*lToLeft).Column=1AndRange("a"&i)=""ThenRange("a"&i).EntireRow.Delete'如整行为空白则删除整行EndIfNe*tiEndSub'通过依次赋色给单元格的例子，展示简单的OnErrorGoToLine1用法：SubYjue()'过程名DimiAsInteger'定义i为整型OnErrorGoToLine1'遇到错误跳转到Line1Fori=0To65'予设从0循环到65Cells(i+1,2).Interior.ColorInde*=i'依次赋色给第2列的单元格Cells(i+1,1)=i'依次给第1列的单元格标上色索引号Ne*tiE*itSub'退出过程Line1:'遇到错误跳转到这行继续执行MsgBo*"默认颜色只有"&i-1&"种。"'提示对话框EndSub'结束过程'通过显示或取消网格线，展示运算符“Not”应用的简单示例：DimmyLineAsBoolean'定义变量myLine为布尔型WithmandButton1'With语句结构If.Caption="取消网格线"Then'如按钮上显示为"取消网格线".Caption="显示网格线"'改按钮上的字幕为"显示网格线"myLine=ActiveWindow.DisplayGridlines'把活动窗口当前网格线的显示状态赋给变量ActiveWindow.DisplayGridlines=NotmyLine'进行逻辑否定运算Else.Caption="取消网格线"'否则按钮上显示为"取消网格线"ActiveWindow.DisplayGridlines=NotmyLine'进行逻辑否定运算EndIfEndWith'结束With语句结构'有选择地删除指定区域的单元格，点击按钮可选择性的删除[A1：A20]区域含有[D1]中字样的单元格；再点击按钮可返回原样；如果替换了[D1]中的字样，点击按钮后所删除[A1：A20]区域中的单元格亦会随着变化。WithmandButton1If.Caption="删除单元格"Then'如按钮显示的字符为:"删除单元格",.Caption="反悔删除"'则改为:"反悔删除"Fori=20To1Step-1'倒循环IfCells(i,1)Like"*"&Range("d1")&"*"ThenCells(i,1).DeleteShift:=*lUp'如循环中发现*个单元格含有[D1]中字符,则删除该单元格EndIfNe*tiElse.Caption="删除单元格"'否则让按钮显示的字符为:"删除单元格"Range("a1:a20")=Range("f1:f20").Value'把[F1:F20]赋给[A1:A20],为了可反复测试EndIfEndWith'限制鼠标只能在[B2:G60]以外的区域活动的例子：WithActiveSheet'With语句,在一个单一对象上执行一系列的语句.Unprotect'解除没设密码的工作表保护.Cells.Locked=False'解除活动工作表中所有单元格的“锁定”.Range("b2:g60").Locked=True'只锁定[B2:G60]区域.EnableSelection=*lUnlockedCells'仅允许选定未被有效锁定的单元格.Protect'工作表保护(没设密码)EndWith'With语句结束'一个复制数据后，只能粘贴数值的例子PrivateSubWorksheet_SelectionChange(ByValTAsRange)'工作表SelectionChange事件OnErrorResumeNe*t'忽略代码运行中的错误,并越过错误继续执行后面的语句IfT.Column=1Then'如活动单元格为第一列时执行下面的语句Selection.PasteSpecialPaste:=*lPasteValues'粘贴数值Application.CutCopyMode=False'立即清空剪贴板EndIf'IF结构结束EndSub'本过程结束'如何用VBA获得工作簿名称"ForEachwbkInWorkbooksMsgBo*wbk.NameNe*t1.显示活动工作簿名称MsgBo*"当前活动工作簿是"&ActiveWorkbook.Name2.保存活动工作簿Activeworkbook.Save3.保存所有打开的工作簿关闭E*CELForEachWinApplication.WorkbooksW.SaveNe*tWApplication.Quit4.将网格线设置为蓝色ActiveWindow.GridlineColorInde*=55.将工作表sheet1隐藏Sheet1.Visible=*lSheetVeryHidden6.将工作表Shtte1显示Sheet1.Visible=*lSheetVisible7.单击*单元格,该单元格所在的行以蓝色背景填充,字体颜色为白色PrivateSubWorksheet_SelectionChange(ByValTargetAsE*cel.Range)IfTarget.Row>=2Then’第二行以下的区域OnErrorResumeNe*t[ChangColor_With1].FormatConditions.DeleteTarget.EntireRow.Name="ChangColor_With1"With[ChangColor_With1].FormatConditions.Delete.Add*lE*pression,,"TRUE".Item(1).Interior.ColorInde*=5.Item(1).Font.ColorInde*=2EndWithEndIfEndSub8.使窗体在启动的时候自动最大化PrivateSubUserForm_Initialize()Application.WindowState=*lMa*imizedWithApplicationMe.Top=.TopMe.Left=.LeftMe.Height=.HeightMe.Width=.WidthEndWithEndSub9.不保存工作簿退出E*CELApplication.DisplayAlerts=FalseApplication.Quit10.使窗体的关闭按纽不好用PrivateSubUserForm_QueryClose(CancelAsInteger,CloseModeAsInteger)IfCloseMode=vbformcontrdmenuThenMsgBo*"请用关闭按钮关闭窗口!!",64,"提示"Cancel=TrueEndIfEndSub11.使窗体在3秒后自动关闭PrivateSubUserForm_Activate()Application.WaitNow+TimeValue("00:00:03")UserForm1.HideEndSub12.启动窗体的时候自动使Label1显示Sheet1工作表3列,8行的容PrivateSubUserForm_Activate()Label1.Caption=Sheets("sheet1").Cells(3,8)EndSub13.让按纽mandButton1在窗体上以不可用状态显示mandButton1.Enabled=False14.让按纽mandbutton1在窗体上以隐藏方式存在mandButton10.Visible=False15.点击mandbutton1按纽进入”工资”工作表Sheets("工资").Select16.在Te*tbo*1中输入数据,窗体可显示出”工资”工作表中与输入容关联的项PrivateSubTe*tBo*1_Change()For*=1ToApplication.CountA(Sheets("工资").Range("a:a"))IfSheets("工资").Cells(*,1)=Te*tBo*1.Te*tThen’在工资表第一列查找与Te*tbo*1输入相符的项Label2.Caption=Sheets("工资").Cells(*,2)’在Label2中显示Te*tbo*1数据所在的第二列的数据Label7.Caption=Sheets("工资").Cells(*,3)’在Label2中显示Te*tbo*1数据所在的第三列的数据EndIfNe*tEndSub17.使E*CEL启动的时候自动最小化/最大化PrivateSubWorkbook_Open()Application.WindowState=*lMinimized’最小化Application.WindowState=*lMa*imized’最大化EndSub18.在Label25以数字的形式显示Te*tBo*12×Label14的结果Label25.Caption=Val(Te*tBo*12.Te*t)*Val(Label14.Caption)19.单选按纽名与Sheet6工作表名相同OptionButton6.Caption=Sheet6.Name20.”登陆”窗体的显示,隐藏登陆.Show’显示登陆.Hide’隐藏21.使窗体的标题栏不显示(1)插入类模块”CFormChanger”代码如下:PrivateDeclareFunctionFindWindowLib"user32"Alias"FindWindowA"(ByVallpClassNameAsString,ByVallpWindowNameAsString)AsLongPrivateDeclareFunctionGetWindowLongLib"user32"Alias"GetWindowLongA"(ByValhWndAsLong,ByValnInde*AsLong)AsLongPrivateDeclareFunctionSetWindowLongLib"user32"Alias"SetWindowLongA"(ByValhWndAsLong,ByValnInde*AsLong,ByValdwNewLongAsLong)AsLongPrivateDeclareFunctionDrawMenuBarLib"user32"(ByValhWndAsLong)AsLongPrivateConstGWL_STYLEAsLong=(-16)PrivateConstWS_CAPTIONAsLong=&HC00000DimhWndFormAsLong……………………………..PublicPropertySetForm(oFormAsObject)'29IfVal(Application.Version)<9ThenhWndForm=FindWindow("Thunder*Frame",oForm.Caption)ElsehWndForm=FindWindow("ThunderDFrame",oForm.Caption)EndIfSetFormStyleEn