(代码)常用的VBA短句(带注释)

  • 格式:doc
  • 大小:66.00 KB
  • 文档页数:10

[A65536].End(xlUp).Row 'A列末行向上第一个有值的行数[A1].End(xlDown).Row 'A列首行向下第一个有值之行数[IV1].End(xlToLeft).Column '第一行末列向左第一列有数值之列数。

[A1].End(xlToRight).Column '第一行首列向右有连续值的末列之列数mandBars("Standard").Controls(2).BeginGroup = True '在常用工具栏第二个按钮前插入分隔符Cells.WrapText = False '取消自动换行If Len(Target) > 5 Then '如果当前单元格中的字符数超过5个,执行下一行Target.WrapText = True '自动换行End If[A1:B10].SpecialCells(xlCellTypeBlanks).Rows.Hidden = True '有空格即隐藏行[A2] '返回活动单元格的工作表名[A2] '返回活动单元格的工作簿名勾选"VBA项目的信任"Application.SendKeys "%(tmstv){ENTER}" '在Excel 窗口操作Application.SendKeys "%(qtmstv){ENTER}" '在VBE 窗口操作mandBars("命令按钮名称").Position = msoBarFloating '使[命令按钮]悬浮在表格中mandBars("命令按钮名称").Position = msoBarTop '使[命令按钮]排列在工具栏中ActiveSheet.Protect Password:="wshzw" '为工作表保护加口令ActiveSheet.Unprotect Password:="wshzw" '解除工作表保护ActiveSheet.ProtectContents '判断工作表是否处于保护状态Application.DisplayAlerts = False '屏蔽确认提示ActiveCell.CurrentRegion.Select '选择与活动单元格相连的区域Range("a2:a20").NumberFormatLocal = "00-00" '区域的格式化ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row '已用区域的最末行ActiveSheet.Copy Before:=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 = xlLandscape '设置为横向打印ActiveSheet.PageSetup.Orientation = xlPortrait '设置为纵向打印Application.WindowState = xlMinimized '最小化窗口Application.WindowState = xlNormal '最大化窗口ActiveWorkbook.FullName '当前窗口文件名与路径Application.AltStartupPath = "E:\My\MyStart" '替补启动目录路径Application.AutoRecover.Path '返回/设置Excel存储"自动恢复"临时文件的完整路径Application.DefaultFilePath '选项>常规中的默认工作目录Application.Evaluate ("=INFO(""directory"")") '默认工作目录Application.LibraryPath '返回库文件夹的路径workTemplatesPath '返回保存模板的网络路径Application.Path '返回应用程序完整路径Application.RecentFiles.Item(1).Path '返回最近使用的某个文件路径,Item(1)=第一个文件Application.StartupPath 'Excel启动文件夹的路径Application.TemplatesPath '返回模板所存储的本地路径erLibraryPath '返回用户计算机上COM 加载宏的安装路径Debug.Print Application.PathSeparator '路径分隔符"\"CurDir '默认工作目录Excel.Parent.DefaultFilePath '默认工作目录ThisWorkbook.Path '返回当前工作薄的路径ActiveCell.Offset(, -1).Name = "hzw" '定义名称ActiveCell.Precedents.Address '被当前单元格所引用的区域地址ActiveCell.Resize(0, 2).Select '选定当前单元格并向右延伸二格ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).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:\My Documents\33.xls")或FileDateTime (ThisWorkbook.FullName) '文件被创建或最后修改后的日期和时间FileLen (ThisWorkbook.FullName) / 1024或FileLen ("E:\My Documents\temp\33.xls") / 1024 '文件的长度(大小),单位是KBDim mm(2, 10)Range("a1:b10") = mm '可以将二维数组赋值给RangeApplication.Dialogs(xlDialogSaveAs).Show '显示保存对话框T = Application.GetOpenFilename("Text Files (*.dat), *.dat") '选择文件打开路径'如下代码可使工作簿打开后30秒(或闲置30秒)内不输入、不重新选择等,自动关闭工作簿Private Sub Workbook_Open() '工作簿打开事件tt '工作簿打开时启动tt 过程End SubPrivate Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) '工作表变化事件tt '工作表中任一单元格有变化时启动tt 过程End SubPrivate Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) '工作表选择变化事件tt '工作表中单元格的选择有变化时启动tt 过程End SubSub tt() 'tt 过程Dim myNow As Date, BL As Integer '定义myNow为日期型;定义BL为长整型myNow = Now '把当前的时间赋给变量myNowDo '开始循环语句DoBL = Second(Now) - Second(myNow) '循环中不断检查变量BL的值If BL = 30 Then GoTo Cl '当BL=30即跳转到CLDoEvents '转让控制权,以便sheets可继续操作Loop Until BL > 30 '当BL>30即跳出循环Exit SubCl:Application.EnableEvents = False '避免引起其他事件ActiveWorkbook.Close True '关闭活动工作簿并保存Application.EnableEvents = True '可触发其他事件End SubRange("e4").AddComment.Text "代头" & Chr(10) & "内容……" '添加批注Range("e4").Comment.Visible = True '显示批注把工作簿中所有工作表的指定列调整为最佳列宽:Sub 调整列宽()Dim i%For i = 1 To Sheets.Count '遍历工作簿中所有的工作表Sheets(i).Columns("A:K").AutoFit '把每个工作表的[A:K]列调整为最佳列宽Next iEnd SubDo循环语句的几种形式:'1.Do While i > 1 '条件为True时执行'... ... '要执行的语句Loop'2.Do Until i > 1 '条件为False时执行'... ... '要执行的语句Loop'3.Do'... ... '要执行的语句Loop While i > 1 '条件为True时执行'4.Do'... ... '要执行的语句Loop Until i > 1 '条件为False时执行'5.While...Wend 语句While i > 1 '条件为True时执行'... ... '要执行的语句Wend工作表的复制与命名Sub wshzw()Dim i As IntegerFor i = 1 To 5Sheets("Sheet1").Copy After:=Sheets(1) 'Before/After 复制新表在Sheets("Sheet1") 前/后 = i & "月" '为复制的新表命名Next iSheets("Sheet1").Name = "总表" '为Sheets("Sheet1") 改名End SubSub 删除工作表()Application.DisplayAlerts = FalseSheet1.DeleteApplication.DisplayAlerts = TrueEnd SubSub 添加工作表()For i = 1 To 5 = iNextEnd Sub[A1:A20].AdvancedFilter xlFilterCopy, [B1], Unique:=True '可去掉重复数据[A2:C32].Replace What:="F", Replacement:="G" '指定范围内的查找与替换ActiveSheet.AutoFilterMode = False '取消自动筛选'执行以下语句可有效缩小工作簿的大小,执行前请先看清每条语句的作用:edRange.ClearComments '清除活动工作表已使用范围所有批注edRange.ClearFormats '清除活动工作表已使用范围所有格式edRange.Validation.Delete '取消活动工作表已使用范围的数据有效性ActiveSheet.Hyperlinks.Delete '删除活动工作表超链接ActiveSheet.DrawingObjects.Delete '删除活动工作表已使用范围的所有对象edRange = edRange.Value '取消活动工作表已使用范围的公式并保留值还有:Sub x()Dim myRange As StringmyRange = edRange.Address '去除活动工作表无数据的行列End Sub'这相当于把新的已使用区域赋值给变量,效果等同于手工删除多余的列或行后立即保存;来一个函数的Private Sub Worksheet_SelectionChange(ByVal Target As Range)'右边单元格反向显示活动单元格文本If ActiveCell.Column < 256 Then ActiveCell.Offset(0, 1) = StrReverse(ActiveCell)End SubSub test()Dim myRange As StringmyRange = edRange.AddressDebug.Print "LastRow=" & Cells.SpecialCells(xlCellTypeLastCell).RowDebug.Print "LastColumn=" & Cells.SpecialCells(xlCellTypeLastCell).ColumnmyRange = ""End Sub如上下相邻单元格数据相同则删除一个Sub Yjue()Dim myCell As Range, NCell As Range '定义Set myCell = ActiveSheet.Range("b2") '把对象ActiveSheet.Range("b2")赋给变量myCellDo While Not IsEmpty(myCell) '条件为True时执行Set NCell = myCell.Offset(1, 0) '把对象myCell的下一个单元格赋给变量NCellIf NCell.Value = myCell.Value Then '如上下相邻单元格数据相同,则望下执行myCell.Delete '删除myCellEnd If '结束条件语句Set myCell = NCell '把变量NCell赋给变量myCell,等于在循环中把原myCell 下移了一格LoopEnd Sub复制行高列宽与内容:Sub Yjue() '过程的名称Sheet2.Rows("2:23").Copy '复制行区域Sheet3.Select '选择粘贴区域Range("A2").PasteSpecial Paste:=xlPasteColumnWidths '粘贴类型ActiveSheet.Paste '实施粘贴Application.CutCopyMode = False '取消复制模式End Sub如整行为空白则删除整行:Sub DelRow()Dim i As Integer, LastRow As IntegerLastRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row '把最后行的行号赋给变量For i = LastRow To 1 Step -1 '倒循环If Range("iv" & i).End(xlToLeft).Column = 1 And Range("a" & i) = "" ThenRange("a" & i).EntireRow.Delete '如整行为空白则删除整行End IfNext iEnd Sub'通过依次赋色给单元格的例子,展示简单的On Error GoTo Line1 用法:Sub Yjue() '过程名Dim i As Integer '定义i 为整型On Error GoTo Line1 '遇到错误跳转到Line1For i = 0 To 65 '予设从0 循环到65Cells(i + 1, 2).Interior.ColorIndex = i '依次赋色给第2列的单元格Cells(i + 1, 1) = i '依次给第1列的单元格标上色索引号Next iExit Sub '退出过程Line1: '遇到错误跳转到这行继续执行MsgBox "默认颜色只有" & i - 1 & "种。