Excel中最常用的300句VBA编程语句

excel vba常用代码Excel VBA是一种用于编写宏的编程语言，它可以帮助我们在Excel 中进行自动化操作。

在VBA中，有一些常用的代码，可以帮助我们快速完成一些常见的任务。

本文将介绍一些常用的Excel VBA代码，帮助读者更好地理解并运用它们。

一、数据处理1.1 数据筛选在Excel中，我们经常需要根据某些条件筛选数据。

使用VBA可以实现自动筛选，代码如下：```ActiveSheet.Range("A1:D10").AutoFilter Field:=1, Criteria1:=">10"```以上代码将自动筛选出范围为A1:D10的数据，其中第一列大于10的数据。

1.2 数据排序有时候，我们需要对数据进行排序。

使用VBA可以实现自动排序，代码如下：```ActiveSheet.Range("A1:D10").Sort Key1:=Range("A1"), Order1:=xlAscending```以上代码将自动对范围为A1:D10的数据根据第一列进行升序排序。

1.3 数据透视表数据透视表可以帮助我们对数据进行汇总和分析。

使用VBA可以自动生成数据透视表，代码如下：```ActiveSheet.PivotTableWizard```以上代码将自动生成一个数据透视表。

二、单元格操作2.1 单元格赋值在VBA中，我们可以使用代码将某个值赋给指定的单元格，代码如下：```Range("A1").Value = "Hello World"```以上代码将把"Hello World"赋值给A1单元格。

2.2 单元格格式设置使用VBA可以设置单元格的格式，例如设置字体、颜色、边框等，代码如下：```Range("A1").Font.Bold = TrueRange("A1").Interior.Color = RGB(255, 0, 0)Range("A1").Borders.LineStyle = xlContinuous```以上代码将设置A1单元格的字体为粗体、背景色为红色、边框为实线。

ExcelExcel之VBA编程常用语句300句(257) Range("A1:B2").Item(2, 3)或Range("A1:B2")(2, 3) ‘引用单元格C2的数据Range("A1:B2")(3) ‘引用单元格A2(258) ActiveSheet.Cells(1, 1).Font.Bold = TRUE ‘设置字体加粗ActiveSheet.Cells(1, 1).Font.Size = 24 ‘设置字体大小为24磅ActiveSheet.Cells(1, 1).Font.ColorIndex = 3 ‘设置字体颜色为红色ActiveSheet.Cells(1, 1).Font.Italic = TRUE ‘设置字体为斜体ActiveSheet.Cells(1, 1) = "Times New Roman" ‘设置字体类型ActiveSheet.Cells(1, 1).Interior.Col orIndex = 3 ‘将单元格的背景色设置为红色(259) ActiveSheet.Range("C2:E6").AutoFormat Format:=xlRangeAutoFormatColor3 '将当前工作表中单元格区域C2至E6格式自动调整为彩色3格式(260) Cells.SpecialCells(xlCellTypeLastCell) ‘选中当前工作表中的最后一个单元格(261) ActiveCell.CurrentArray.Select '选定包含活动单元格的整个数组单元格区域.假定该单元格在数据单元格区域中(262) ActiveCell.NumberFormatLocal = "0.000; [红色] 0.000" '将当前单元格数字格式设置为带3位小数,若为负数则显示为红色(263) IsEmpty (ActiveCell.Value) '判断活动单元格中是否有值(264) ActiveCell.Value = LTrim(ActiveCell.Value) '删除字符串前面的空白字符(265) Len(ActiveCell.Value) '获取活动单元格中字符串的个数(266) ActiveCell.Value = UCase(ActiveCell.Value) '将当前单元格中的字符转换成大写(267) ActiveCell.Value = StrConv(ActiveCell.Value, vbLowerCase) '将活动单元格中的字符串转换成小写(268) ActiveSheet.Range("C1").AddComment '在当前工作表的单元格C1中添加批注(269) Weekday(Date) '获取今天的星期,以数值表示,1-7分别对应星期日至星期六(270) ActiveSheet.Range("A1").AutoFill Range(Cells(1, 1), Cells(10, 1)) '将单元格A1的数值填充到单元格A1至A10区域中(271) DatePart("y", Date) '获取今天在全年中的天数(272) ActiveCell.Value = DateAdd("yyyy", 2, Date) '获取两年后的今天的日期(273) MsgBox WeekdayName(Weekday(Date)) '获取今天的星期数(274) ActiveCell.Value = Year(Date) '在当前单元格中输入今年的年份数ActiveCell.Value = Month(Date) '在当前单元格中输入今天所在的月份数ActiveCell.Value = Day(Date) '在当前单元格中输入今天的日期数(275) ActiveCell.Value = MonthName(1) '在当前单元格中显示月份的名称,本句为显示"一月"(276) ActiveCell.Value = Hour(Time) '在当前单元格中显示现在时间的小时数ActiveCell.Value = Minute(Time) '在当前单元格中显示现在时间的分钟数ActiveCell.Value = Second(Time) '在当前单元格中显示现在时间的秒数(277) ActiveSheet.Shapes(1).Delete '删除当前工作表中的第一个形状(278) ActiveSheet.Shapes.Count '获取当前工作表中形状的数量(279) ActiveSheet.Shapes(1).TextEffect.ToggleVerticalText '改变当前工作表中第一个艺术字的方向(280) ActiveSheet.Shapes(1).TextEffect.FontItalic = True '将当前工作表中第一个艺术字的字体设置为斜体(281) ActiveSheet.Shapes.AddTextEffect(msoTextEffect21, "三峡", _"Arial Black", 22#, msoFalse, msoFalse, 66#, 80).Select '在当前工作表中创建一个名为"三峡"的艺术字并对其进行格式设置和选中(282) ActiveSheet.Shapes.AddLine(BeginX:=10, BeginY:=10, EndX:=250, _EndY:=100).Select '在当前工作表中以(10,10)为起点(250,100)为终点画一条直线并选中(283)ActiveSheet.Shapes.AddShape(Type:=msoShapeRightTriangle, _ Left:=70, Top:=40, Width:=130, Height:=72).Select '在当前工作表中画一个左上角在(70,40),宽为130高为72的三角形并选中(284)ActiveSheet.Shapes.AddShape(Type:=msoShapeRectangle, _ Left:=70, Top:=40, Width:=130, Height:=72).Select '在当前工作表中画一个以点(70,40)为起点,宽130高72的矩形并选中(285) ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, _ Left:=70, Top:=40, Width:=130, Height:=72).Select '在当前工作表中画一个左上角在(70,40),宽为130高为72的椭圆(286) ActiveSheet.Shapes(1).Line.ForeColor.RGB = RGB(0, 0, 255) '将当前工作表中第一个形状的线条颜色变为蓝色(287) ActiveSheet.Shapes(2).Fill.ForeColor.RGB = RGB(255, 0, 0) '将当前工作表中第2个形状的前景色设置为红色(288) ActiveSheet.Shapes(1).Rotation = 20 '将当前工作表中的第1个形状旋转20度(289) Selection.ShapeRange.Flip msoFlipHorizontal '将当前选中的形状水平翻转Selection.ShapeRange.Flip msoFlipVertical '将当前选中的形状垂直翻转(290) Selection.ShapeRange.ThreeD.SetThreeDFormat msoThreeD1 '将所选取的形状设置为第1种立体样式(291) ActiveSheet.Shapes(1).ThreeD.Depth = 20 '将当前工作表中第一个立体形状的深度设置为20(292) ActiveSheet.Shapes(1).ThreeD.ExtrusionColor.RGB = RGB(0, 0, 255) '将当前工作表中第1个立体形状的进深部分的颜色设为蓝色(293) ActiveSheet.Shapes(1).ThreeD.RotationX = 60 '将当前工作表中的第1个立体形状沿X轴旋转60度ActiveSheet.Shapes(1).ThreeD.RotationY = 60 '将当前工作表中的第1个立体形状沿Y轴旋转60度(294) Selection.ShapeRange.ThreeD.Visible = msoFalse '将所选择的立体形状转换为平面形状(295)Selection.ShapeRange.ConnectorFormat.BeginDisconnect '在形状中让指定的连接符起点脱离原来所连接的形状(296) ActiveSheet.Shapes(1).PickUp '复制当前工作表中形状1的格式(297)ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 260, 160, 180, 30). TextFrame.Characters.T ext = "" '在工作簿中新建一个文本框并输入内容(298)ActiveSheet.Shapes.AddLabel(msoTextOrientationHorizontal, 20, 80, 100, 200). TextFrame.Characters.Text = "" '在当前工作表中建立一个水平文本框并输入内容(299) ActiveSheet.Shapes.AddPicture "d:\sx.jpg", True, True, 60, 20, 400, 300 '在当前工作表中插入一张d盘中名为sx的图片(300) ActiveChart.ApplyCustomType xl3DArea '将当前图表类型改为三维面积图。

经典ExcelVBA代码Application（Excel程序）篇Application.EnableEvents= True/ False ’启用/禁用所有事件Application.DisplayAlerts=True/False ’显示/关闭警告框提示框Application.ScreenUpdating= True/False ’显示/关闭屏幕刷新Application.StatusBar = "软件报专用" ’在地址栏中显示文本，标题栏用Caption属性Application.Cursor = xlIBeam ‘设置光标形状为Ⅰ字形，xlWait为沙漏(等待)形，xlNormal为正常Application.WindowState = xlMinimized ‘窗口最小化，xlMaximized最大化，xlNormal为正常Application.ActivateMicrosoftApp xlMicrosoftWord ’开启Word应用程序Application.TemplatesPath ‘获取工作簿模板的位置Application.CalculateFull ’重新计算所有打开的工作簿中的数据Application.RecentFiles.Maximum = 2 ’将最近使用的文档列表数设为2Application.RecentFiles(3).Open ’打开最近打开的文档中的第3个文档Application.AutoCorrect.AddReplacement "sweek", "软件报" ’自动将输入的"sweek"更正为"软件报"Application.Dialogs(xlDialogPrint).Show ‘显示打印文档的对话框Application.OnTime Now + TimeValue("00:00:45"), "process" ’45分钟后执行指定过程Application.OnTime TimeValue("14:00:00"), " process " ’下午2点执行指定过程Application.OnTime EarliestTime:=TimeValue("14:00:00"), _ Procedure:="process", Schedule:=False ’取消指定时间的过程的执行Application.CutCopyMode = False 退出复制/剪切模式后，在程序运行时所进行的复制或剪切操作不会在原单元格区域留下流动的虚框线。

宏文件集▲打开全部隐藏工作表返回Sub 打开全部隐藏工作表()Dim i As IntegerFor i = 1 To Sheets.CountSheets(i).Visible = TrueNext iEnd Sub▲循环宏返回Sub 循环()AAA = Range("C2")Dim i As LongDim times As Longtimes = AAA'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)For i = 1 To timesCall 过滤一行If Range("完成标志") = "完成" Then Exit For '如果名为'完成标志'的命名单元的值等于'完成',则退出循环,如果一开始就等于'完成',则只执行一次循环就退出'If Sheets("传送参数").Range("A" & i).Text = "完成" Then Exit For '如果某列出现"完成"内容则退出循环Next iEnd Sub▲录制宏时调用“停止录制”工具栏返回Sub 录制宏时调用停止录制工具栏()mandBars("Stop Recording").Visible = TrueEnd Sub▲高级筛选5列不重复数据至指定表返回Sub 高级筛选5列不重复数据至Sheet2()Sheets("Sheet2").Range("A1:E65536") = "" '清除Sheet2的A:D列Range("A1:E65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet2.Range( _"A1"), Unique:=TrueSheet2.Columns("A:E").Sort Key1:=Sheet2.Range("A2"), Order1:=xlAscending,Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYinEnd Sub▲双击单元执行宏(工作表代码)返回Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Range("$A$1") = "关闭" Then Exit SubSelect Case Target.AddressCase "$A$4"Call 宏1Cancel = TrueCase "$B$4"Call 宏2Cancel = TrueCase "$C$4"Call 宏3Cancel = TrueCase "$E$4"Call 宏4Cancel = TrueEnd SelectEnd Sub▲双击指定区域单元执行宏(工作表代码)返回Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Range("$A$1") = "关闭" Then Exit SubIf Not Application.Intersect(Target, Range("A4:A9", "C4:C9")) Is Nothing Then Call 打开隐藏表End Sub▲进入单元执行宏(工作表代码)返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)'以单元格进入代替按钮对象调用宏If Range("$A$1") = "关闭" Then Exit SubSelect Case Target.AddressCase "$A$5" '单元地址(Target.Address),或命名单元名字()Call 宏1Case "$B$5"Call 宏2Case "$C$5"Call 宏3End SelectEnd Sub▲进入指定区域单元执行宏(工作表代码)返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Range("$A$1") = "关闭" Then Exit SubIf Not Application.Intersect(Target, Range("A4:A9","C4:C9")) Is Nothing Then Call打开隐藏表End Sub▲在多个宏中依次循环执行一个（控件按钮代码）返回Private Sub CommandButton1_Click()Static RunMacro As IntegerSelect Case RunMacroCase 0宏1RunMacro = 1Case 1宏2RunMacro = 2Case 2宏3RunMacro = 0End SelectEnd Sub▲在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）返回Private Sub CommandButton1_Click()With CommandButton1If .Caption = "保护工作表" ThenCall 保护工作表.Caption = "取消工作表保护"Exit SubEnd IfIf .Caption = "取消工作表保护" ThenCall 取消工作表保护.Caption = "保护工作表"Exit SubEnd IfEnd WithEnd Sub▲在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）返回Option ExplicitPrivate Sub CommandButton1_Click()With CommandButton1If .Caption = "宏1" ThenCall 宏1.Caption = "宏2"Exit SubEnd IfIf .Caption = "宏2" ThenCall 宏2.Caption = "宏3"Exit SubEnd IfIf .Caption = "宏3" ThenCall 宏3.Caption = "宏1"Exit SubEnd IfEnd WithEnd Sub▲根据A1单元文本隐藏/显示按钮（控件按钮代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Range("A1") > 2 ThenCommandButton1.Visible = 1ElseCommandButton1.Visible = 0End IfEnd SubPrivate Sub CommandButton1_Click()重排窗口End Sub▲当前单元返回按钮名称（控件按钮代码）返回Private Sub CommandButton1_Click()ActiveCell = CommandButton1.CaptionEnd Sub▲当前单元内容返回到按钮名称（控件按钮代码）返回Private Sub CommandButton1_Click()CommandButton1.Caption = ActiveCellEnd Sub▲奇偶页分别打印返回Sub 奇偶页分别打印()Dim i%, Ps%Ps = ExecuteExcel4Macro("GET.DOCUMENT(50)") '总页数MsgBox "现在打印奇数页,按确定开始."For i = 1 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iMsgBox "现在打印偶数页,按确定开始."For i = 2 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iEnd Sub▲自动打印多工作表第一页返回Sub 自动打印多工作表第一页()Dim sh As IntegerDim xDim yDim syDim syzx = InputBox("请输入起始工作表名字:")sy = InputBox("请输入结束工作表名字:")y = Sheets(x).Indexsyz = Sheets(sy).IndexFor sh = y To syzSheets(sh).SelectSheets(sh).PrintOut from:=1, To:=1Next shEnd Sub▲查找A列文本循环插入分页符返回Sub 循环插入分页符()' Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容Dim i As LongDim times As Longtimes = Application.WorksheetFunction.CountIf(Sheet1.Range("a:a"), "分页")'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)For i = 1 To timesCall 插入分页符Next iEnd SubSub 插入分页符()Cells.Find(What:="分页", After:=ActiveCell, LookIn:=xlValues, LookAt:= _xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _.ActivateActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCellEnd SubSub 取消原分页()Cells.SelectActiveSheet.ResetAllPageBreaksEnd Sub▲将A列最后数据行以上的所有B列图片大小调整为所在单元大小返回Sub 将A列最后数据行以上的所有B列图片大小调整为所在单元大小()Dim Pic As Picture, i&i = [A65536].End(xlUp).RowFor Each Pic In Sheet1.PicturesIf Not Application.Intersect(Pic.TopLeftCell, Range("B1:B" & i)) Is Nothing ThenPic.Top = Pic.TopLeftCell.TopPic.Left = Pic.TopLeftCell.LeftPic.Height = Pic.TopLeftCell.HeightPic.Width = Pic.TopLeftCell.WidthEnd IfNextEnd Sub▲返回光标所在行数返回Sub 返回光标所在行数()x = ActiveCell.RowRange("A1") = xEnd Sub▲在A1返回当前选中单元格数量返回Sub 在A1返回当前选中单元格数量()[A1] = Selection.CountEnd Sub▲返回当前工作簿中工作表数量返回Sub 返回当前工作簿中工作表数量()t = Application.Sheets.CountMsgBox tEnd Sub▲返回光标选择区域的行数和列数返回Sub 返回光标选择区域的行数和列数()x = Selection.Rows.County = Selection.Columns.CountRange("A1") = xRange("A2") = yEnd Sub▲工作表中包含数据的最大行数返回Sub 包含数据的最大行数()n = Cells.Find("*", , , , 1, 2).RowMsgBox nEnd Sub▲返回A列数据的最大行数返回Sub 返回A列数据的最大行数()n = Range("a65536").End(xlUp).RowRange("B1") = nEnd Sub▲将所选区域文本插入新建文本框返回Sub 将所选区域文本插入新建文本框()For Each rag In Selectionn = n & rag.Value & Chr(10)NextActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, ActiveCell.Left +ActiveCell.Width, ActiveCell.Top + ActiveCell.Height, 250#, 100).SelectSelection.Characters.Text = "问题：" & nWith Selection.Characters(Start:=1, Length:=3).Font.Name = "黑体".FontStyle = "常规".Size = 12End WithEnd Sub▲批量插入地址批注返回Sub 批量插入地址批注()On Error Resume NextDim r As RangeIf Selection.Cells.Count > 0 ThenFor Each r In Selectionment.Deleter.AddCommentment.Visible = Falsement.Text Text:="本单元格：" & r.Address & " of " & Selection.AddressNextEnd IfEnd Sub▲批量插入统一批注返回Sub 批量插入统一批注()Dim r As Range, msg As Stringmsg = InputBox("请输入欲批量插入的批注", "提示", "随便输点什么吧")If Selection.Cells.Count > 0 ThenFor Each r In Selectionr.AddCommentment.Visible = Falsement.Text Text:=msgNextEnd IfEnd Sub▲以A1单元内容批量插入批注返回Sub 以A1单元内容批量插入批注()Dim r As RangeIf Selection.Cells.Count > 0 ThenFor Each r In Selectionr.AddCommentment.Visible = Falsement.Text Text:=[a1].TextNextEnd IfEnd Sub▲不连续区域插入当前文件名和表名及地址返回Sub 批量插入当前文件名和表名及地址()For Each mycell In Selectionmycell.FormulaR1C1 = "[" + + "]" + +"!" + mycell.AddressNextEnd Sub▲不连续区域录入当前单元地址返回Sub 区域录入当前单元地址()For Each mycell In Selectionmycell.FormulaR1C1 = mycell.AddressNextEnd Sub▲连续区域录入当前单元地址返回Sub 连续区域录入当前单元地址()Selection = "=ADDRESS(ROW(),COLUMN(),4,1)"Selection.CopySelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=FalseEnd Sub▲返回当前单元地址返回Sub 返回当前单元地址()d = ActiveCell.Address[A1] = dEnd Sub▲不连续区域录入当前日期返回Sub 区域录入当前日期()Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d")End Sub▲不连续区域录入当前数字日期返回Sub 区域录入当前数字日期()Selection.FormulaR1C1 = Format(Now(), "yyyymmdd")End Sub▲不连续区域录入当前日期和时间返回Sub 区域录入当前日期和时间()Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d h:mm:ss")End Sub▲不连续区域录入对勾返回Sub 批量录入对勾()Selection.FormulaR1C1 = "√"End Sub▲不连续区域录入当前文件名返回Sub 批量录入当前文件名()Selection.FormulaR1C1 = End Sub▲不连续区域添加文本返回Sub 批量添加文本()Dim s As RangeFor Each s In Selections = s & "文本内容"NextEnd Sub▲不连续区域插入文本返回Sub 批量插入文本()Dim s As RangeFor Each s In Selections = "文本内容" & sNextEnd Sub▲从指定位置向下同时录入多单元指定内容返回Sub 从指定位置向下同时录入多单元指定内容()Dim arrarr = Array("1", "2", "13", "25", "46", "12", "0", "20")[B2].Resize(8, 1) = Application.WorksheetFunction.Transpose(arr)End Sub▲按aa工作表A列的内容排列工作表标签顺序返回Sub 按aa工作表A列的内容排列工作表标签顺序()Dim I%, str1$I = 1Sheets("aa").SelectDo While Cells(I, 1).Value <> ""str1 = Trim(Cells(I, 1).Value)Sheets(str1).SelectSheets(str1).Move after:=Sheets(I)I = I + 1Sheets("aa").SelectLoopEnd Sub▲以A1单元文本作表名插入工作表返回Sub 以A1单元文本作表名插入工作表()Dim nm As Stringnm = [a1]Sheets.Add = nmEnd Sub▲删除全部未选定工作表返回Sub 删除全部未选定工作表()Dim sht As Worksheet, n As Integer, iFlag As BooleanDim ShtName() As Stringn = ActiveWindow.SelectedSheets.CountReDim ShtName(1 To n)n = 1For Each sht In ActiveWindow.SelectedSheetsShtName(n) = n = n + 1NextApplication.DisplayAlerts = FalseFor Each sht In SheetsiFlag = FalseFor i = 1 To n - 1If ShtName(i) = TheniFlag = TrueExit ForEnd IfNextIf Not iFlag Then sht.DeleteNextApplication.DisplayAlerts = TrueEnd Sub▲工作表标签排序返回Sub 工作表标签排序()Dim i As Long, j As Long, nums As Long, msg As Longmsg = MsgBox("工作表按升序排列请选 '是[Y]'. " & vbCrLf & vbCrLf & "工作表按降序排列请选 '否[N]'", vbYesNoCancel, "工作表排序")If msg = vbCancel Then Exit Subnums = Sheets.CountIf msg = vbYes Then 'Sort ascendingFor i = 1 To numsFor j = i To numsIf UCase(Sheets(j).Name) < UCase(Sheets(i).Name) ThenSheets(j).Move Before:=Sheets(i)End IfNext jNext iElse 'Sort descendingFor i = 1 To numsFor j = i To numsIf UCase(Sheets(j).Name) > UCase(Sheets(i).Name) ThenSheets(j).Move Before:=Sheets(i)End IfNext jNext iEnd IfEnd Sub▲定义指定工作表标签颜色返回Sub 定义指定工作表标签颜色()Sheets("Sheet1").Tab.ColorIndex = 46End Sub▲在目录表建立本工作簿中各表链接目录返回Sub 在目录表建立本工作簿中各表链接目录()Dim s%, Rng As RangeOn Error Resume NextSheets("目录").ActivateIf Err = 0 ThenSheets("目录").UsedRange.DeleteElseSheets.Add = "目录"End IfFor i = 1 To Sheets.CountIf Sheets(i).Name <> "目录" Thens = s + 1Set Rng = Sheets("目录").Cells(((s - 1) Mod 20) + 1, (s - 1) \ 20 + 1 + 1)Rng = Format(s, " 0") & ". " & Sheets(i).NameActiveSheet.Hyperlinks.Add Rng, "#" & Sheets(i).Name & "!A1",ScreenTip:=Sheets(i).NameEnd IfNextSheets("目录").Range("b:iv").EntireColumn.ColumnWidth = 20End Sub▲建立工作表文本目录返回Sub 建立工作表文本目录()Sheets.Add before:=Sheets(1)Sheets(1).Name = "目录"For i = 2 To Sheets.CountCells(i - 1, 1) = Sheets(i).Name'Sheets(1).Hyperlinks.Add Cells(i - 1, 1), "#" & Sheets(i).Name & "!A1" '添加超链接NextEnd Sub▲查另一文件的全部表名返回Sub 查另一文件的全部表名()On Error Resume NextDim i%Dim sh As WorksheetApplication.ScreenUpdating = FalseWorkbooks.Open Filename:=ThisWorkbook.Path & "\2.xls"Windows("1.xls").Activate '当前文件名称Sheets("Sheet1").Select '当前表名称i = 1 '将表名称返回到第1行For Each sh In Workbooks("2.xls").WorksheetsCells(i, 1) = '将表名称返回到第1列i = i + 1 '返回每个表名称向下移动1行Next shWindows("2.xls").Close '关闭对象文件Application.ScreenUpdating = TrueEnd Sub▲当前单元录入计算机名返回Sub 当前单元录入计算机名()Selection = Environ("COMPUTERNAME")'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub▲当前单元录入计算机用户名返回 Sub 当前单元录入计算机用户名()Selection = Environ("Username")'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub▲解除全部工作表保护返回Sub 解除全部工作表保护()Dim n As IntegerFor n = 1 To Sheets.CountSheets(n).UnprotectNext nEnd Sub▲为指定工作表加指定密码保护表返回Sub 为指定工作表加指定密码保护表()Sheet10.Protect Password:="123"End Sub▲在有密码的工作表执行代码返回Sub 在有密码的工作表执行代码()Sheets("1").Unprotect Password:=123 '假定表名为“1”，密码为“123” 打开工作表Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True '隐藏C列空值行Sheets("1").Protect Password:=123 '重新用密码保护工作表End Sub▲执行前需要验证密码的宏(控件按钮代码)返回Private Sub CommandButton1_Click()If InputBox("请输入密码：") <> "123" Then '密码是123MsgBox "密码错误,按确定退出!", 64, "提示"Exit SubEnd IfCells(1, 1) = 10End SubSub 执行前需要验证密码的宏()If InputBox("请输入您的使用权限:", "系统提示") = 123 Then重排窗口 '要执行的宏代码或宏名称ElseMsgBox "对不起,您没有使用该宏的权限,按确定键后退出!"End IfEnd Sub▲拷贝A1公式和格式到A2返回Sub 拷贝A1公式到A2()Workbooks("临时表").Sheets("表1").Range("A1").CopyWorkbooks("临时表").Sheets("表2").Range("A2").PasteSpecialEnd Sub▲复制单元数值返回Sub 复制数值()s = Workbooks("book1").Sheets("Sheet1").Range("A1:A2")Workbooks("book2").Sheets("Sheet1").Range("A1:A2") = sEnd Sub▲插入数值条件格式返回Sub 插入数值条件格式()Selection.FormatConditions.DeleteSelection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _Formula1:="70"Selection.FormatConditions(1).Interior.ColorIndex = 45Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _Formula1:="55"Selection.FormatConditions(2).Interior.ColorIndex = 39Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _Formula1:="60"Selection.FormatConditions(3).Interior.ColorIndex = 34End Sub▲插入透明批注返回Sub 插入透明批注()Selection.AddCommentment.Visible = FalseDim XS As WorksheetFor i = 1 To ments.Countments(i).Text "透明批注"ments(i).Shape.Fill.Visible = msoFalseNextEnd Sub▲添加文本返回Sub 添加文本()Selection = Selection + "×" '不可在数字后添加文本'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub▲光标定位到指定工作表A列最后数据行下一单元返回Sub 光标定位到指定工作表A列最后数据行下一单元()a = Sheets("数据库").[a65536].End(xlUp).RowSheets("数据库").SelectRange("A" & a + 1).SelectEnd Sub▲定位选定单元格式相同的全部单元格返回Sub 定位选定单元格式相同的全部单元格()Dim FirstCell As Range, FoundCell As RangeDim AllCells As RangeWith Application.FindFormat.Clear.NumberFormatLocal = Selection.NumberFormatLocal.HorizontalAlignment = Selection.HorizontalAlignment.VerticalAlignment = Selection.VerticalAlignment.WrapText = Selection.WrapText.Orientation = Selection.Orientation.AddIndent = Selection.AddIndent.IndentLevel = Selection.IndentLevel.ShrinkToFit = Selection.ShrinkToFit.MergeCells = Selection.MergeCells = .Font.FontStyle = Selection.Font.FontStyle.Font.Size = Selection.Font.Size.Font.Strikethrough = Selection.Font.Strikethrough.Font.Subscript = Selection.Font.Subscript.Font.Underline = Selection.Font.Underline.Font.ColorIndex = Selection.Font.ColorIndex.Interior.ColorIndex = Selection.Interior.ColorIndex.Interior.Pattern = Selection.Interior.Pattern.Locked = Selection.Locked.FormulaHidden = Selection.FormulaHiddenEnd WithSet FirstCell = edRange.Find(what:="", searchformat:=True)If FirstCell Is Nothing ThenExit SubEnd IfSet AllCells = FirstCellSet FoundCell = FirstCellDoSet FoundCell = edRange.Find(After:=FoundCell, what:="",searchformat:=True)If FoundCell Is Nothing Then Exit DoSet AllCells = Union(FoundCell, AllCells)If FoundCell.Address = FirstCell.Address Then Exit DoLoopAllCells.SelectEnd Sub▲按当前单元文本定位返回Sub 按当前单元文本定位()ABC = SelectionDim aa As RangeFor Each a In edRangeIf a Like ABC ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.Cells)End IfEnd IfNextaa.SelectEnd Sub▲按固定文本定位返回Sub 文本定位()Dim aa As RangeFor Each a In edRangeIf a Like "*合计*" ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.Cells)End IfEnd IfNextaa.SelectEnd Sub▲删除包含固定文本单元的行或列返回Sub 删除包含固定文本单元的行或列()DoCells.Find(what:="哈哈").ActivateSelection.EntireRow.Delete '删除行' Selection.EntireColumn.Delete '删除列Loop Until Cells.Find(what:="哈哈") Is NothingEnd Sub▲定位数据及区域以上的空值返回Sub 定位数据及区域以上的空值()Dim aa As RangeFor Each a In edRangeIf a Like 〈0 ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.Cells)End IfEnd IfNextaa.SelectEnd Sub▲右侧单元自动加5(工作表代码)返回Private Sub Worksheet_Change(ByVal Target As Range)Application.EnableEvents = FalseTarget.Offset(0, 1) = Target + 5Application.EnableEvents = TrueEnd Sub▲当前单元加2返回Sub 当前单元加2()Selection = Selection + 2'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub▲A列等于A列减B列返回Sub A列等于A列减B列()For i = 1 To 23Cells(i, 1) = Cells(i, 1) - Cells(i, 2)NextEnd Sub▲用于光标选定多区域跳转指定单元(工作表代码)返回Private Sub Worksheet_SelectionChange(ByVal T As Range)a = Array([b6:b7], [e6], [h6])For i = 0 To 2If Not Application.Intersect(T, a(i)) Is Nothing Then[a1].Select: Exit ForEnd IfNextEnd Sub▲将A1单元录入的数据累加到B1单元（工作表代码）返回Private Sub Worksheet_Change(ByVal Target As Range)Dim t As LongIf Target.Address = "$A$1" Thent = Sheet1.Range("$B$1").ValueSheet1.Range("$B$1").Value = t + Target.ValueEnd IfEnd Sub▲在指定颜色区域选择单元时添加/取消"√"（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim myrg As RangeFor Each myrg In TargetIf myrg.Interior.ColorIndex = 37 Then myrg = IIf(myrg <> "√", "√", "")NextEnd Sub▲在指定区域选择单元时添加/取消"√"（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim Rng As RangeIf Target.Count <= 15 ThenIf Not Application.Intersect(Target, Range("D6:D20")) Is Nothing ThenFor Each Rng In SelectionWith RngIf .Value = "" Then.Value = "√"Else.Value = ""End IfEnd WithNextEnd IfEnd IfEnd Sub▲双击指定单元，循环录入文本（工作表代码）返回Private Sub Worksheet_BeforeDoubleClick(ByVal T As Range, Cancel As Boolean)If T.Address <> "$A$1" Then Exit SubCancel = TrueT = IIf(T = "好", "中", IIf(T = "中", "差", "好"))End Sub双击指定单元，循环录入文本（工作表代码）Dim nums As BytePrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$A$1" Thennums = nums Mod 3 + 1Target = Mid("上中下", nums, 1)Target.Offset(1, 0).SelectEnd IfEnd Sub▲单元区域引用（工作表代码）返回Private Sub Worksheet_Activate()Sheet1.Range("A1:B3").Value = Sheet2.Range("A1:B3").ValueEnd Sub▲在指定区域选择单元时数值加1（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Not Application.Intersect([a1:e10], Target) Is Nothing ThenTarget = Val(Target) + 1End IfEnd Sub▲混合文本的编号返回Sub 混合文本的编号()Worksheets(1).Range("B2").Value = "北京" & (--(Mid(Worksheets(1).Range("B2"), 3,100)) + 1)End Sub▲指定区域单元双击数据累加（工作表代码）返回Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Not Application.Intersect([A1:Y100], Target) Is Nothing Thenoldvalue = Val(Target.Value)inputvalue = InputBox("请输入数量,按ENTER键确认!", "数值累加器")Target.Value = oldvalue + inputvalueEnd IfEnd Sub▲选择单元区域触发事件（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Address = "$A$1:$B$2" ThenMsgBox "你选择了$A$1:$B$2单元"End IfEnd Sub▲当修改指定单元内容时自动执行宏（工作表代码）返回Private Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target, [B3:B4]) Is Nothing Then重排窗口End IfEnd Sub▲被指定单元内容限制执行宏返回Sub 被指定单元限制执行宏()If Range("$A$1") = "关闭" Then Exit Sub窗口End Sub▲双击单元隐藏该行（工作表代码）返回Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)Rows(Target.Row).Hidden = TrueEnd Sub▲高亮显示行（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)Cells.Interior.ColorIndex = 2Rows("1:2").Interior.ColorIndex = 40 '保持1至2行的颜色推荐39,22,40,Rows(Target.Row).Interior.ColorIndex = 35 '高亮推荐颜色35,20,24,34,37,40,15End Sub▲高亮显示行和列（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal Target As Range)Cells.Interior.ColorIndex = xlNoneRows(Target.Row).Interior.ColorIndex = 34Columns(Target.Column).Interior.ColorIndex = 34End Sub▲为指定工作表设置滚动范围（工作簿代码）返回Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target AsRange)Sheet1.ScrollArea = "A1:M30"End Sub▲在指定单元记录打印和预览次数（工作簿代码）返回Private Sub Workbook_BeforePrint(Cancel As Boolean)Range("A1") = 1 + Range("A1")End Sub▲自动数字金额转大写（工作表代码）返回Private Sub Worksheet_Change(ByVal M As Range)On Error Resume Nexty = Int(Round(100 * Abs(M)) / 100)j = Round(100 * Abs(M) + 0.00001) - y * 100f = (j / 10 - Int(j / 10)) * 10A = IIf(y < 1, "", Application.Text(y, "[DBNum2]") & "元")b = IIf(j > 9.5, Application.Text(Int(j / 10), "[DBNum2]") & "角", IIf(y < 1,"", IIf(f > 1, "零", "")))c = IIf(f < 1, "整", Application.Text(Round(f, 0), "[DBNum2]") & "分")M = IIf(Abs(M) < 0.005, "", IIf(M < 0, "负" & A & b & c, A & b & c))End Sub▲将全部工作表的A1单元作为单击按钮（工作簿代码）返回Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target AsRange)If Target.Address = "$A$1" ThenCall 宏名End IfEnd Sub▲闹钟——到指定时间执行宏（工作簿代码）返回Private Sub Workbook_Open()Application.OnTime ("11:45:00"), "提示1" '宏名字Application.OnTime ("12:00:00"), "提示2" '宏名字End Sub▲改变Excel界面标题的宏（工作簿代码）返回Private Sub Workbook_Open()Application.Caption = "春节快乐"End Sub▲在指定工作表的指定单元返回光标当前多选区地址（工作簿代码）返回Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target AsRange)Worksheets("表2").Range("A1") = Target.Address(0, 0)End Sub▲B列录入数据时在A列返回记录时间（工作表代码）返回Public Sub Worksheet_Change(ByVal Target As Range)If Target.Column = 2 ThenTarget.Offset(, -1) = NowEnd IfEnd Sub▲当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码）返回Public Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target, [A1:A1000]) Is Nothing ThenIf Target.Column = 1 ThenTarget.Offset(, 1) = DateTarget.Offset(, 2) = TimeEnd IfEnd IfEnd SubPublic Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target, [A1:A1000]) Is Nothing ThenIf Target.Column = 1 ThenTarget.Offset(, 1) = Format(Now(), "yyyy-mm-dd")Target.Offset(, 2) = Format(Now(), "h:mm:ss")End IfEnd IfEnd Sub▲指定单元显示光标位置内容（工作表代码）返回Private Sub Worksheet_SelectionChange(ByVal T As Range)Sheets(1).Range("A1") = SelectionEnd Sub▲每编辑一个单元保存文件返回Private Sub Worksheet_Change(ByVal Target As Range)ThisWorkbook.SaveEnd Sub▲指定允许编辑区域返回Sub 指定允许编辑区域()ActiveSheet.ScrollArea = "B8:G15"End Sub▲解除允许编辑区域限制返回Sub 解除允许编辑区域限制()ActiveSheet.ScrollArea = ""End Sub▲删除指定行返回Sub 删除指定行()Workbooks("临时表").Sheets("表2").Range("5:5").DeleteEnd Sub▲删除A列为指定内容的行返回Sub 删除A列为指定内容的行()Dim a, b As Integera = Sheet1.[a65536].End(xlUp).RowFor b = a To 2 Step -1If Cells(b, 1).Value = "删除" ThenRows(b).DeleteEnd IfNextEnd Sub▲删除A列非数字单元行返回Sub 删除A列非数字单元行()i = [a65536].End(xlUp).RowRange("A1:A" & i).SpecialCells(xlCellTypeConstants, 2).EntireRow.DeleteEnd Sub▲有条件删除当前行返回Sub 有条件删除当前行()If [A1] = 2 Or [B1] = "删除" ThenSelection.Delete Shift:=xlUpEnd IfEnd Sub▲选择下一行返回Sub 选择下一行()ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.SelectEnd Sub▲选择第5行开始所有数据行返回Sub 选择第5行开始所有数据行A()Dim i%i = Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues,SearchDirection:=xlPrevious).EntireRow.RowRows("5:" & i).SelectEnd SubSub 选择第5行开始所有数据行B()Rows("5:" & Cells.Find("*", , , , 1, 2).Row).SelectEnd Sub▲选择光标或选区所在行返回Sub 选择光标或选区所在行()Selection.EntireRow.Select▲选择光标或选区所在列返回Sub 选择光标或选区所在列()Selection.EntireColumn.SelectEnd Sub▲光标定位到名称指定位置返回Sub 定位()Application.Goto Range(Evaluate("名称"))End Sub▲选择名称定义的数据区返回Sub 选择名称定义的数据区()[数据区].Select '插入名称要使用INDIRECT函数'Range("数据区").Select 或者'Sheet1.Range("数据区").Select 或者End Sub▲选择到指定列的最后行返回Sub 选择到指定列的最后行()Range("C4:G" & [G65536].End(xlUp).Row).SelectEnd Sub▲将Sheet1的A列的非空值写到Sheet2的A列返回Sub 将Sheet1的A列的非空值写到Sheet2的A列()Sheet1.Columns("A:A").SpecialCells(2, 23).SpecialCells(12).Copy Sheet2.[A1]End Sub▲将名称1的数据写到名称2返回Sub Macro2()Range("位置2") = Range("位置1").Value▲单元反选返回Sub 单元反选()Application.DisplayAlerts = FalseApplication.ScreenUpdating = FalseDim raddress As String, taddress As Stringraddress = Selection.Addresstaddress = edRange.AddressWith Sheets.Add.Range(taddress) = 0.Range(raddress) = "=0"raddress = .Range(taddress).SpecialCells(xlCellTypeConstants, 1).Address.DeleteEnd WithActiveSheet.Range(raddress).SelectApplication.ScreenUpdating = TrueEnd Sub▲调整选中对象中的文字返回Sub 调整选中对象中的文字()'文字居中、自动调整大小With Selection.HorizontalAlignment = xlCenter.VerticalAlignment = xlCenter.ReadingOrder = xlContext.Orientation = xlHorizontal.AutoSize = True.AddIndent = FalseEnd WithEnd Sub▲去除指定范围内的对象返回Sub 去除指定范围内的对象()。

Excel中VBA代码段汇集，附中文解说vba语句(1) Option Explicit '强制对模块内所有变量进行声明(2) Option Base 1 '指定数组的第一个下标为1(3) On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息(4) On Error GoT o 100 '当错误发生时跳转到过程中的某个位置(5) On Error GoT o 0 '恢复正常的错误提示(6) Application.DisplayAlerts=False '在程序执行过程中使出现的警告框不显示(7) Application.DisplayAlerts=True '在程序执行过程中(8) Application.ScreenUpdating=False '关闭屏幕刷新(9) Application.ScreenUpdating = True '打开屏幕刷新(10) Workbooks.Add() '创建一个新的工作簿(11) Workbooks(“book1.xls”).Activate '激活名为book1的工作簿(12) ThisWorkbook.Save '保存工作簿(13) ThisWorkbook.close '关闭当前工作簿(14) ActiveWorkbook.Sheets.Count '获取活动工作薄中工作表数(15) '返回活动工作薄的名称(16) ‘返回当前工作簿名称(17) ThisWorkbook.FullName ‘返回当前工作簿路径和名(18) (18) edRange.Rows.Count ‘当前工作表中已使用的行数(19) Rows.Count ‘获取工作表的行数(注：考虑兼容性)(20) Sheets(Sheet1).Name= “Sum” '将Sheet1命名为Sum(21) ThisWorkbook.Sheets.Add Before:=Worksheets(1) '添加一个新工作表在第一工作表前(22) ActiveSheet.Move After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count) '将当前工作表移至工作表的最后(23) Worksheets(Array(“sheet1”,”sheet2”)).Select '同时选择工作表1和工作表2(24) Sheets(“sheet1”).Delete或Sheets(1).Delete '删除工作表1(25) edRange.FormatConditions.Delete ‘删除当前工作表中所有的条件格式(26) Cells.Hyperlinks.Delete ‘取消当前工作表所有超链接(27) ActiveCell.CurrentRegion.Select选择当前活动单元格所包含的范围，上下左右无空行(28) Cells.Select ‘选定当前工作表的所有单元格(29) Range(“A1”).ClearContents '清除活动工作表上单元格A1中的Selection.ClearContents '清除选定区域内容Range(“A1:D4”).Clear '彻底清除A1至D4单元格区域的内容，包括格式(30) Cells.Clear '清除工作表中所有单元格的内容(31) ActiveCell.Offset(1,0).Select '活动单元格下移一行，同理，可下移一列(32) Range(“A1”).Copy Range(“B1”) '复制单元格A1，粘贴到单元格B1中(33) Range(“A1:D8”).Copy Range(“F1”) '将单元格区域复制到单元格F1开始的区域中(34) Range(“A1:D8”).Cut Range(“F1”) '剪切单元格区域A1至D8，复制到单元格F1开始的区域中(35) Range(“A1”).CurrentRegion.Copy Sheets(“Sheet2”).Range(“A1”) '复制包含A1的单元格区域到工作表2中以A1起始的单元格区域中注：CurrentRegion属性等价于定位命令，由一个矩形单元格块组成，周围是一个或多个空行或列(36) ActiveWindow.RangeSelection.Count '活动窗口中选择的单元格数(37) Selection.Count '当前选中区域的单元格数(38) Range(“A1”).Interior.ColorIndex ‘获取单元格A1背景色(39) cells.count ‘返回当前工作表的单元格数(40) Range(“B3”).Resize(11, 3)(41) Union(Range(“A1:A9”),Range(“D1:D9”)) 区域连接(42) Intersect(Range(“A1:B9”),Range(“A1:D9”))) ‘返回的交叉区域(43) Selection.Columns.Count ‘当前选中的单元格区域中的列数(44) Selection.Rows.Count ‘当前选中的单元格区域中的行数(45) edRange.Row ‘获取单元格区域中使用的第一行的行号(46) Application.WorksheetFunction.IsNumber(“A1”) '使用工作表函数检查A1单元格中的数据是否为数字(47)Range(“A:A”).Find(Application.WorksheetFunction.Max(Range(“A:A”))).Activate'激活单元格区域A列中最大值的单元格(48) MsgBox “Hello!” '消息框中显示消息Hello(49) Ans=MsgBox(“Continue?”,vbYesNo) '在消息框中点击“是”按钮，则Ans值为vbYes；点击“否”按钮，则Ans值为vbNo。

前言我们平时在工作表单元格的公式中常常使用函数，Excel自带的常用的函数多达300多个，功能强大，丰富多彩，但是在VBA中不能直接应用，必须在函数名前面加上对象，比如：Application.WorksheetFunction.Sum(arg1,arg2,arg3)。

而能在VBA中直接应用的函数也有几十个，下面将逐一详细介绍常用的40个VBA 函数，以供大家学习参考。

第1.1例 ASC函数一、题目：要求编写一段代码，运行后得到字符串”Excel”的首字母和”e”的ASCII 值。

二、代码：Sub 示例_1_01()Dim myNum1%, myNum2%myNum1 = Asc("Excel") '返回69myNum2 = Asc("e") '返回101[a1] = "myNum1= ": [b1] = myNum1[a2] = "myNum2= ": [b2] = myNum2End Sub三、代码详解1、Sub 示例_1_01()：宏程序的开始语句。

2、Dim myNum1%, myNum2%：变量myNum1和myNum2声明为整型变量。

也可以写为 Dim myNum1 As Integer 。

Integer 变量存储为 16位（2 个字节）的数值形式，其范围为 -32,768 到 32,767 之间。

Integer 的类型声明字符是百分比符号 (%)。

3、myNum1 = Asc("Excel")：把Asc函数的值赋给变量myNum1。

Asc函数返回一个 Integer，代表字符串中首字母的字符的ASCII代码。

语法Asc(string)必要的 string（字符串）参数可以是任何有效的字符串表达式。

如果 string 中没有包含任何字符，则会产生运行时错误。

4、myNum2 = Asc("e")：把Asc函数的值赋给变量myNum2。

删除B列中字符串数值少于21的单元格所在的行Sub 删除行()r = Range("B65536").End(xlUp).Row '行数For h = r To 1 Step -1If Cells(h, 2) < 21 Then Cells(h, 2).EntireRow.DeleteNextEnd Sub-------------------------【工作表合并】将同一工作簿中的所有工作表合并到一个工作表中新建一个工作表，写入代码[在新建的工作表标签处右键查看代码（找不到的直接按一下alt+F11) 把下面的代码复制进去然后点上面的运行运行子程序即可]：Sub 合并当前工作簿下的所有工作表()Application.ScreenUpdating = FalseFor j = 1 To Sheets.CountIf Sheets(j).Name <> ThenX = Range("A65536").End(xlUp).Row + 1Sheets(j).UsedRange.Copy Cells(X, 1)End IfNextRange("B1").SelectApplication.ScreenUpdating = TrueMsgBox "当前工作簿下的全部工作表已经合并完毕！", vbInformation, "提示"End Sub*********************************************************代码这样写也行：Sub c()For i = Sheets.Count To 2 Step -1Sheets(i).SelectSheets(i).UsedRange.CopySheets(1).SelectCells(Cells(65000, 1).End(xlUp).Row + 1, 1).SelectActiveSheet.Paste'Sheets(i).DeleteNext iEnd Sub************************************************************把一个工作簿中的所有表单合并成一个表单，怎么去掉重复的表头、标题行？方法如下：Sub c()For i = Sheets.Count To 2 Step -1Sheets(i).UsedRange.Offset(1).Copy Sheets(1).Cells(65536, 1).End(xlUp).Offset(1) Next iEnd Sub说明：函数OFFSET(reference,rows,cols,height,width)以指定的引用为参照系，通过给定偏移量得到新的引用。

VBA语句集(第1辑)定制模块行为(1) Option Explicit '强制对模块内所有变量进行声明Option Private Module '标记模块为私有，仅对同一工程中其它模块有用，在宏对话框中不显示Option Compare Text '字符串不区分大小写Option Base 1 '指定数组的第一个下标为1(2) On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息(3) On Error GoTo ErrorHandler '当错误发生时跳转到过程中的某个位置(4) On Error GoTo 0 '恢复正常的错误提示(5) Application.DisplayAlerts=False '在程序执行过程中使出现的警告框不显示(6) Application.ScreenUpdating=False '关闭屏幕刷新Application.ScreenUpdating=True '打开屏幕刷新(7) Application.Enable.CancelKey=xlDisabled '禁用Ctrl+Break中止宏运行的功能工作簿(8) Workbooks.Add() '创建一个新的工作簿(9) Workbooks(“book1.xls”).Activate '激活名为book1的工作簿(10) ThisWorkbook.Save '保存工作簿(11) ThisWorkbook.close '关闭当前工作簿(12) ActiveWorkbook.Sheets.Count '获取活动工作薄中工作表数(13) '返回活动工作薄的名称(14) '返回当前工作簿名称ThisWorkbook.FullName '返回当前工作簿路径和名称(15) ActiveWindow.EnableResize=False '禁止调整活动工作簿的大小(16) Application.Window.Arrange xlArrangeStyleTiled '将工作簿以平铺方式排列(17) ActiveWorkbook.WindowState=xlMaximized '将当前工作簿最大化工作表(18) edRange.Rows.Count '当前工作表中已使用的行数(19) Rows.Count '获取工作表的行数(注：考虑向前兼容性)(20) Sheets(Sheet1).Name= “Sum” '将Sheet1命名为Sum(21) ThisWorkbook.Sheets.Add Before:=Worksheets(1) '添加一个新工作表在第一工作表前(22) ActiveSheet.Move After:=ActiveWorkbook. _Sheets(ActiveWorkbook.Sheets.Count) '将当前工作表移至工作表的最后(23) Worksheets(Array(“sheet1”,”sheet2”)).Select '同时选择工作表1和工作表2(24) Sheets(“sheet1”).Delete或Sheets(1).Delete '删除工作表1(25) ActiveWorkbook.Sheets(i).Name '获取工作表i的名称(26) ActiveWindow.DisplayGridlines=Not ActiveWindow.DisplayGridlines '切换工作表中的网格线显示，这种方法也可以用在其它方面进行相互切换，即相当于开关按钮(27) ActiveWindow.DisplayHeadings=Not ActiveWindow.DisplayHeadings '切换工作表中的行列边框显示(28) edRange.FormatConditions.Delete '删除当前工作表中所有的条件格式(29) Cells.Hyperlinks.Delete '取消当前工作表所有超链接(30) ActiveSheet.PageSetup.Orientation=xlLandscape或ActiveSheet.PageSetup.Orientation=2 '将页面设置更改为横向(31) ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName '在页面设置的表尾中输入文件路径ActiveSheet.PageSetup.LeftFooter=erName '将用户名放置在活动工作表的页脚单元格/单元格区域(32) ActiveCell.CurrentRegion.Select或Range(ActiveCell.End(xlUp),ActiveCell.End(xlDown)).Select'选择当前活动单元格所包含的范围，上下左右无空行(33) Cells.Select '选定当前工作表的所有单元格(34) Range(“A1”).ClearContents '清除活动工作表上单元格A1中的内容Selection.ClearContents '清除选定区域内容Range(“A1:D4”).Clear '彻底清除A1至D4单元格区域的内容，包括格式(35) Cells.Clear '清除工作表中所有单元格的内容(36) ActiveCell.Offset(1,0).Select '活动单元格下移一行，同理，可下移一列(37) Range(“A1”).Offset(ColumnOffset:=1)或Range(“A1”).Offset(,1) '偏移一列Ra nge(“A1”).Offset(Rowoffset:=-1)或Range(“A1”).Offset(-1) '向上偏移一行(38) Range(“A1”).Copy Range(“B1”) '复制单元格A1，粘贴到单元格B1中Range(“A1:D8”).Copy Range(“F1”) '将单元格区域复制到单元格F1开始的区域中Range(“A1:D8”).Cut Range(“F1”) '剪切单元格区域A1至D8，复制到单元格F1开始的区域中Range(“A1”).CurrentRegion.Copy Sheets(“Sheet2”).Range(“A1”) '复制包含A1的单元格区域到工作表2中以A1起始的单元格区域中注：CurrentRegion属性等价于定位命令，由一个矩形单元格块组成，周围是一个或多个空行或列(39) ActiveWindow.RangeSelection.Value=XX '将值XX输入到所选单元格区域中(40) ActiveWindow.RangeSelection.Count '活动窗口中选择的单元格数(41) Selection.Count '当前选中区域的单元格数(42) GetAddress=Replace(Hyperlinkcell.Hyperlinks(1).Address,mailto:,””) '返回单元格中超级链接的地址并赋值(43) TextColor=Range(“A1”).Font.ColorIndex '检查单元格A1的文本颜色并返回颜色索引Range(“A1”).Interior.ColorIndex '获取单元格A1背景色(44) cells.count '返回当前工作表的单元格数(45) Selection.Range(“E4”).Select '激活当前活动单元格下方3行，向右4列的单元格(46) Cells.Item(5,”C”) '引单元格C5Cells.Item(5,3) '引单元格C5(47) Range(“A1”).Offset(RowOffset:=4,ColumnOffset:=5)或Range(“A1”).Offset(4,5) '指定单元格F5(48) Range(“B3”).Resize(RowSize:=11,ColumnSize:=3)Rnage(“B3”).Resize(11,3) '创建B3：D13区域(49) Range(“Data”).Resize(,2) '将Data区域扩充2列(50) Union(Range(“Data1”),Range(“Data2”)) '将Data1和Data2区域连接(51) Intersect(Range(“Data1”),Range(“Data2”)) '返回Data1和Data2区域的交叉区域(52) Range(“Data”).Count '单元格区域Data中的单元格数Range(“Data”). Columns.Count '单元格区域Data中的列数Range(“Data”). Rows.Count '单元格区域Data中的行数(53) Selection.Columns.Count '当前选中的单元格区域中的列数Selection.Rows.Count '当前选中的单元格区域中的行数(54) Selection.Areas.Count '选中的单元格区域所包含的区域数(55) edRange.Row '获取单元格区域中使用的第一行的行号(56) Rng.Column '获取单元格区域Rng左上角单元格所在列编号(57) ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions) '在活动工作表中返回所有符合条件格式设置的区域(58) Range(“A1”).AutoFilter Field:=3,VisibleDropDown:=False '关闭由于执行自动筛选命令产生的第3个字段的下拉列表名称(59) Range(“A1：C3”).Name=“computer” '命名A1：C3区域为computer或Range(“D1：E6”).Name=“Sheet1!book” '命名局部变量，即Sheet1上区域D1：E6为book或Names(“computer”).Name=“robot” '将区域computer重命名为robot(60) Names(“book”).Delete '删除名称(61) Names.Add Name:=“ContentList”，_RefersTo:=“=OFFSET(Sheet1!A2,0,0,COUNTA(Sheet2!$A:$A))” '动态命名列(62) Names.Add Name:=“Company”,RefersTo:=“CompanyCar” '命名字符串CompanyCar(63) Names.Add Name:=“Total”,RefersTo:=123456 '将数字123456命名为Total。

001.批量创建工作表2020年4月17日4:04Sub NewSht()Dim shtActive As Worksheet, sht As WorksheetDim i As Long, strShtName As StringOn Error Resume Next '当代码出错时继续运行Set shtActive = ActiveSheetFor i = 2 To shtActive.Cells(Rows.Count, 1).End(xlUp).Row'单元格A1是标题，跳过，从第2行开始遍历工作表名称strShtName = shtActive.Cells(i, 1).Value'工作表名强制转换为字符串类型Set sht = Sheets(strShtName)'当工作簿不存在工作表Sheets(strShtName)时，这句代码会出错，然后…… If Err Then'如果代码出错，说明不存在工作表Sheets(t)，则新建工作表Worksheets.Add , Sheets(Sheets.Count)'新建一个工作表，位置放在所有已存在工作表的后面 = strShtName'新建的工作表必然是活动工作表，为之命名Err.Clear'清除错误状态End IfNextshtActive.Activate'重新激活原工作表End Sub002.删除全部工作表2020年11月25日22:13Sub DelShet() '删除所有工作表Dim sht As WorksheetApplication.ScreenUpdating = False '关屏幕刷新Application.DisplayAlerts = False '关警告信息 On Error Resume NextFor Each sht In Worksheetssht.Delete '遍历工作表删除NextApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub003.提取工作表名字2020年11月25日22:14Sub GetShtByVba()Dim sht As Worksheet, k As LongApplication.ScreenUpdating = Falsek = 1Range("a:b").Clear '清空数据Range("a:a").NumberFormat = "@" '设置文本格式For Each sht In Worksheets '遍历工作表取表名k = k + 1Cells(k, 1) = NextRange("a1:b1") = Array("工作表名", "是否删除") Application.ScreenUpdating = TrueEnd Sub004.删除指定工作表2020年11月25日22:15Sub DelShtByVba()Dim sht As Worksheet, i As Long, rApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseOn Error Resume Nextr = Range("a1").CurrentRegion '数据装入数组rFor i = 2 To UBound(r) '遍历并删除工作表If r(i, 2) = "删除" Then Worksheets(CStr(r(i, 1))).Delete NextApplication.ScreenUpdating = TrueApplication.DisplayAlerts = TrueEnd Sub005.生成带超链接的工作表目录2020年11月25日22:15Sub ml()Dim sht As Worksheet, i&, strShtName$Columns(1).ClearContents '清空A列数据Cells(1, 1) = "目录" '第一个单元格写入标题"目录"i = 1 '将i的初值设置为1.For Each sht In Worksheets '循环当前工作簿的每个工作表strShtName = If strShtName <> Then '如果sht的名称不是当前工作表的名称则开始在当前工作表建立超链接i = i + 1 '累加工作表数量ActiveSheet.Hyperlinks.Add anchor:=Cells(i, 1), Address:="", _SubAddress:="'" & strShtName & "'!a1", TextToDisplay:=strShtName'建超链接End IfNextEnd Sub006.在各个分表创建返回总表的命令按钮2020年11月25日22:16Dim strShtName As StringSub Mybutton()Dim sht As Worksheet, btn As ButtonOn Error Resume NextFor Each sht In WorksheetsWith shtIf .Name <> strShtName Then.Shapes(strShtName).Delete'删除原有的名称为shtn的按钮，避免重复创建Set btn = .Buttons.Add(0, 0, 60, 30)'使用add方法在工作表中添加一个按钮控件，add方法语法如下:表达式.Add(left,right,width,height)'新建按钮，释义见小贴士With btn.Name = strShtName'命令按钮命名.Characters.Text = "返回总表"'按钮的文本内容.OnAction = "LinkTable"'指定按钮控件所执行的宏命令End WithEnd IfEnd WithNextSet btn = NothingEnd SubSub LinkTable()strShtName = "总表"'指定了返回总表的名字，可以根据实际需要修改为目标表的名称，比如“目录”。

vb操作Excel 语句集300(1)2011-10-20 8:13定制模块行为(1) Option Explicit '强制对模块内所有变量进行声明Option Private Module '标记模块为私有，仅对同一工程中其它模块有用，在宏对话框中不显示Option Compare Text '字符串不区分大小写Option Base 1 '指定数组的第一个下标为1(2) On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息(3) On Error GoTo ErrorHandler '当错误发生时跳转到过程中的某个位置(4) On Error GoTo 0 '恢复正常的错误提示(5) Application.DisplayAlerts=False '在程序执行过程中使出现的警告框不显示(6) Application.ScreenUpdating=False '关闭屏幕刷新Application.ScreenUpdating=True '打开屏幕刷新(7) Application.Enable.CancelKey=xlDisabled '禁用Ctrl+Break中止宏运行的功能工作簿(8) Workbooks.Add() '创建一个新的工作簿(9) Workbooks(“book1.xls”).Activate '激活名为book1的工作簿(10) ThisWorkbook.Save '保存工作簿(11) ThisWorkbook.close '关闭当前工作簿(12) ActiveWorkbook.Sheets.Count '获取活动工作薄中工作表数(13) '返回活动工作薄的名称(14) ‘返回当前工作簿名称ThisWorkbook.FullName ‘返回当前工作簿路径和名称(15) ActiveWindow.EnableResize=False ‘禁止调整活动工作簿的大小(16) Application.Window.Arrange xlArrangeStyleTiled ‘将工作簿以平铺方式排列(17) ActiveWorkbook.WindowState=xlMaximized ‘将当前工作簿最大化工作表(18) edRange.Rows.Count ‘当前工作表中已使用的行数(19) Rows.Count ‘获取工作表的行数(注：考虑向前兼容性)(20) Sheets(Sheet1).Name= “Sum”'将Sheet1命名为Sum(21) ThisWorkbook.Sheets.Add Before:=Worksheets(1) '添加一个新工作表在第一工作表前(22) ActiveSheet.Move After:=ActiveWorkbook. _Sheets(ActiveWorkbook.Sheets.Count) '将当前工作表移至工作表的最后(23) Worksheets(Array(“sheet1”,”sheet2”)).Select '同时选择工作表1和工作表2(24) Sheets(“sheet1”).Delete或Sheets(1).Delete '删除工作表1(25) ActiveWorkbook.Sheets(i).Name '获取工作表i的名称(26) ActiveWindow.DisplayGridlines=Not ActiveWindow.DisplayGridlines '切换工作表中的网格线显示，这种方法也可以用在其它方面进行相互切换，即相当于开关按钮(27) ActiveWindow.DisplayHeadings=Not ActiveWindow.DisplayHeadings ‘切换工作表中的行列边框显示(28) edRange.FormatConditions.Delete ‘删除当前工作表中所有的条件格式(29) Cells.Hyperlinks.Delete ‘取消当前工作表所有超链接(30) ActiveSheet.PageSetup.Orientation=xlLandscape或ActiveSheet.PageSetup.Orientation=2 '将页面设置更改为横向(31) ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName ‘在页面设置的表尾中输入文件路径ActiveSheet.PageSetup.LeftFooter=erName ‘将用户名放置在活动工作表的页脚单元格/单元格区域(32) ActiveCell.CurrentRegion.Select或Range(ActiveCell.End(xlUp),ActiveCell.End(xlDown)).Select'选择当前活动单元格所包含的范围，上下左右无空行(33) Cells.Select ‘选定当前工作表的所有单元格(34) Range(“A1”).ClearContents '清除活动工作表上单元格A1中的内容Selection.ClearContents '清除选定区域内容Range(“A1:D4”).Clear '彻底清除A1至D4单元格区域的内容，包括格式(35) Cells.Clear '清除工作表中所有单元格的内容(36) ActiveCell.Offset(1,0).Select '活动单元格下移一行，同理，可下移一列(37) Range(“A1”).Offset(ColumnOffset:=1)或Range(“A1”).Offset(,1) ‘偏移一列Range(“A1”).Offset(Rowoffset:=-1)或Range(“A1”).Offset(-1) ‘向上偏移一行(38) Range(“A1”).Copy Range(“B1”) '复制单元格A1，粘贴到单元格B1中Range(“A1:D8”).Copy Range(“F1”) '将单元格区域复制到单元格F1开始的区域中Range(“A1:D8”).Cut Range(“F1”) '剪切单元格区域A1至D8，复制到单元格F1开始的区域中Range(“A1”).CurrentRegion.Copy Sheets(“Sheet2”).Range(“A1”) '复制包含A1的单元格区域到工作表2中以A1起始的单元格区域中注：CurrentRegion属性等价于定位命令，由一个矩形单元格块组成，周围是一个或多个空行或列(39) ActiveWindow.RangeSelection.Value=XX '将值XX输入到所选单元格区域中(40) ActiveWindow.RangeSelection.Count '活动窗口中选择的单元格数(41) Selection.Count '当前选中区域的单元格数(42) GetAddress=Replace(Hyperlinkcell.Hyperlinks(1).Address,mailto:,””) ‘返回单元格中超级链接的地址并赋值(43) TextColor=Range(“A1”).Font.ColorIndex ‘检查单元格A1的文本颜色并返回颜色索引Range(“A1”).Interior.ColorIndex ‘获取单元格A1背景色(44) cells.count ‘返回当前工作表的单元格数(45) Selection.Range(“E4”).Select ‘激活当前活动单元格下方3行，向右4列的单元格(46) Cells.Item(5,”C”) ‘引单元格C5Cells.Item(5,3) ‘引单元格C5(47) Range(“A1”).Offset(RowOffset:=4,ColumnOffset:=5)或Range(“A1”).Offset(4,5) ‘指定单元格F5(48) Range(“B3”).Resize(RowSize:=11,ColumnSize:=3)Rnage(“B3”).Resize(11,3) ‘创建B3：D13区域(49) Range(“Data”).Resize(,2) ‘将Data区域扩充2列(50) Union(Range(“Data1”),Range(“Data2”)) ‘将Data1和Data2区域连接(51) Intersect(Range(“Data1”),Range(“Data2”)) ‘返回Data1和Data2区域的交叉区域(52) Range(“Data”).Count ‘单元格区域Data中的单元格数Range(“Data”). Columns.Count ‘单元格区域Data中的列数Range(“Data”). Rows.Count ‘单元格区域Data中的行数(53) Selection.Columns.Count ‘当前选中的单元格区域中的列数Selection.Rows.Count ‘当前选中的单元格区域中的行数(54) Selection.Areas.Count ‘选中的单元格区域所包含的区域数(55) edRange.Row ‘获取单元格区域中使用的第一行的行号(56) Rng.Column ‘获取单元格区域Rng左上角单元格所在列编号(57) ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions) ‘在活动工作表中返回所有符合条件格式设置的区域(58) Range(“A1”).AutoFilter Field:=3,VisibleDropDown:=False ‘关闭由于执行自动筛选命令产生的第3个字段的下拉列表名称(59) Range(“A1：C3”).Name=“computer”‘命名A1：C3区域为computer或Range(“D1：E6”).Name=“Sheet1!book”‘命名局部变量，即Sheet1上区域D1：E6为book或Names(“computer”).Name=“robot”‘将区域computer重命名为robot(60) Names(“book”).Delete ‘删除名称(61) Names.Add Name:=“ContentList”，_RefersTo:=“=OFFSET(Sheet1!A2,0,0,COUNTA(Sheet2!$A:$A))”‘动态命名列(62) Names.Add Name:=“Company”,RefersTo:=“CompanyCar”‘命名字符串CompanyCar(63) Names.Add Name:=“Total”,RefersTo:=123456 ‘将数字123456命名为Total。

excel常用vba代码和语法Excel VBA（Visual Basic for Applications）是一种为Excel编程的语言，可以使用VBA代码来自动化执行各种操作。

以下是一些常用的VBA代码和语法示例：1. 定义和使用变量：```vbaDim num As Integernum = 10```2. 循环结构：- For循环：```vbaFor i = 1 To 10' 循环体Next i```- While循环：```vbaWhile i < 10' 循环体i = i + 1Wend```3. 条件判断：- If语句：```vbaIf condition Then' 条件满足时执行的代码ElseIf condition Then' 第二个条件满足时执行的代码Else' 条件不满足时执行的代码End If```- Select Case语句：```vbaSelect Case gradeCase "A"' A级别操作Case "B", "C"' B或C级别操作Case Else' 其他情况的操作End Select```4. 定义和调用子过程（函数）：```vbaSub MySubroutine()' 子过程的代码End SubFunction MyFunction()' 函数的代码MyFunction = resultValue ' 返回结果End Function```5. 控制Excel对象：- 打开和关闭工作簿：```vbaWorkbooks.Open ("C:\example.xlsx") ActiveWorkbook.Close```- 读取和写入单元格：```vbaRange("A1").Value = "Hello"value = Range("A1").Value```- 获取和设置工作表属性：```vbaSheets("Sheet1").Activate Worksheets.Add```这些示例演示了一些常用的VBA代码和语法。

Excel VBA语句集(300句)定制模块行为(1) Option Explicit '强制对模块内所有变量进行声明Option Private Module '标记模块为私有，仅对同一工程中其它模块有用，在宏对话框中不显示Option Compare Text '字符串不区分大小写Option Base 1 '指定数组的第一个下标为1(2) On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息(3) On Error GoTo ErrorHandler '当错误发生时跳转到过程中的某个位置(4) On Error GoTo 0 '恢复正常的错误提示(5) Application.DisplayAlerts=False '在程序执行过程中使出现的警告框不显示(6) Application.ScreenUpdating=False '关闭屏幕刷新Application.ScreenUpdating=True '打开屏幕刷新(7) Application.Enable.CancelKey=xlDisabled '禁用Ctrl+Break中止宏运行的功能工作簿(8) Workbooks.Add() '创建一个新的工作簿(9) Workbooks(“book1.xls”).Activate '激活名为book1的工作簿(10) ThisWorkbook.Save '保存工作簿(11) ThisWorkbook.close '关闭当前工作簿，workbooks.close只能关闭里面的，而外面的文件不能关掉。

application.workbooks.quit关闭整个EXCEL表格。

(12) ActiveWorkbook.Sheets.Count '获取活动工作薄中工作表数(13) '返回活动工作薄的名称(14) ‘返回当前工作簿名称ThisWorkbook.FullName ‘返回当前工作簿路径和名称(15) ActiveWindow.EnableResize=False ‘禁止调整活动工作簿的大小(16) Application.Window.Arrange xlArrangeStyleTiled ‘将工作簿以平铺方式排列(17) ActiveWorkbook.WindowState=xlMaximized ‘将当前工作簿最大化工作表(18) edRange.Rows.Count ‘当前工作表中已使用的行数(19) Rows.Count ‘获取工作表的行数(注：考虑向前兼容性)(20) Sheets(Sheet1).Name= “Sum”'将Sheet1命名为Sum(21) ThisWorkbook.Sheets.Add Before:=Worksheets(1) '添加一个新工作表在第一工作表前(22) ActiveSheet.Move After:=ActiveWorkbook. _Sheets(ActiveWorkbook.Sheets.Count) '将当前工作表移至工作表的最后(23) Worksheets(Array(“sheet1”,”sheet2”)).Select '同时选择工作表1和工作表2(24) Sheets(“sheet1”).Delete或Sheets(1).Delete '删除工作表1(25) ActiveWorkbook.Sheets(i).Name '获取工作表i的名称(26) ActiveWindow.DisplayGridlines=Not ActiveWindow.DisplayGridlines '切换工作表中的网格线显示，这种方法也可以用在其它方面进行相互切换，即相当于开关按钮(27) ActiveWindow.DisplayHeadings=Not ActiveWindow.DisplayHeadings ‘切换工作表中的行列边框显示(28) edRange.FormatConditions.Delete ‘删除当前工作表中所有的条件格式(29) Cells.Hyperlinks.Delete ‘取消当前工作表所有超链接(30) ActiveSheet.PageSetup.Orientation=xlLandscape或ActiveSheet.PageSetup.Orientation=2 '将页面设置更改为横向(31) ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName ‘在页面设置的表尾中输入文件路径ActiveSheet.PageSetup.LeftFooter=erName ‘将用户名放置在活动工作表的页脚单元格/单元格区域(32) ActiveCell.CurrentRegion.Select或Range(ActiveCell.End(xlUp),ActiveCell.End(xlDown)).Select'选择当前活动单元格所包含的范围，上下左右无空行(33) Cells.Select ‘选定当前工作表的所有单元格(34) Range(“A1”).ClearContents '清除活动工作表上单元格A1中的内容Selection.ClearContents '清除选定区域内容Range(“A1:D4”).Clear '彻底清除A1至D4单元格区域的内容，包括格式(35) Cells.Clear '清除工作表中所有单元格的内容(36) ActiveCell.Offset(1,0).Select '活动单元格下移一行，同理，可下移一列(37) Range(“A1”).Offset(ColumnOffset:=1)或Range(“A1”).Offset(,1) ‘偏移一列Range(“A1”).Offset(Rowoffset:=-1)或Range(“A1”).Offset(-1) ‘向上偏移一行(38) Range(“A1”).Copy Range(“B1”) '复制单元格A1，粘贴到单元格B1中Range(“A1:D8”).Copy Range(“F1”) '将单元格区域复制到单元格F1开始的区域中Range(“A1:D8”).Cut Range(“F1”) '剪切单元格区域A1至D8，复制到单元格F1开始的区域中Range(“A1”).CurrentRegion.Copy Sheets(“Sheet2”).Range(“A1”) '复制包含A1的单元格区域到工作表2中以A1起始的单元格区域中注：CurrentRegion属性等价于定位命令，由一个矩形单元格块组成，周围是一个或多个空行或列(39) ActiveWindow.RangeSelection.Value=XX '将值XX输入到所选单元格区域中(40) ActiveWindow.RangeSelection.Count '活动窗口中选择的单元格数(41) Selection.Count '当前选中区域的单元格数(42) GetAddress=Replace(Hyperlinkcell.Hyperlinks(1).Address,mailto:,””) ‘返回单元格中超级链接的地址并赋值(43) TextColor=Range(“A1”).Font.ColorIndex ‘检查单元格A1的文本颜色并返回颜色索引Range(“A1”).Interior.ColorIndex ‘获取单元格A1背景色(44) cells.count ‘返回当前工作表的单元格数(45) Selection.Range(“E4”).Select ‘激活当前活动单元格下方3行，向右4列的单元格(46) Cells.Item(5,”C”) ‘引单元格C5Cells.Item(5,3) ‘引单元格C5(47) Range(“A1”).Offset(RowOffset:=4,ColumnOffset:=5)或Range(“A1”).Offset(4,5) ‘指定单元格F5(48) Range(“B3”).Resize(RowSize:=11,ColumnSize:=3)Rnage(“B3”).Resize(11,3) ‘创建B3：D13区域(49) Range(“Data”).Resize(,2) ‘将Data区域扩充2列(50) Union(Range(“Data1”),Range(“Data2”)) ‘将Data1和Data2区域连接(51) Intersect(Range(“Data1”),Range(“Data2”)) ‘返回Data1和Data2区域的交叉区域(52) Range(“Data”).Count ‘单元格区域Data中的单元格数Range(“Data”). Columns.Count ‘单元格区域Data中的列数Range(“Data”). Rows.Count ‘单元格区域Data中的行数(53) Selection.Columns.Count ‘当前选中的单元格区域中的列数Selection.Rows.Count ‘当前选中的单元格区域中的行数(54) Selection.Areas.Count ‘选中的单元格区域所包含的区域数(55) edRange.Row ‘获取单元格区域中使用的第一行的行号(56) Rng.Column ‘获取单元格区域Rng左上角单元格所在列编号(57) ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions) ‘在活动工作表中返回所有符合条件格式设置的区域(58) Range(“A1”).AutoFilter Field:=3,VisibleDropDown:=False ‘关闭由于执行自动筛选命令产生的第3个字段的下拉列表名称(59) Range(“A1：C3”).Name=“computer”‘命名A1：C3区域为computer或Range(“D1：E6”).Name=“Sheet1!book”‘命名局部变量，即Sheet1上区域D1：E6为book或Names(“computer”).Name=“robot”‘将区域computer重命名为robot(60) Names(“book”).Delete ‘删除名称(61) Names.Add Name:=“ContentList”，_RefersTo:=“=OFFSET(Sheet1!A2,0,0,COUNTA(Sheet2!$A:$A))”‘动态命名列(62) Names.Add Name:=“Company”,RefersTo:=“CompanyCar”‘命名字符串CompanyCar(63) Names.Add Name:=“Total”,RefersTo:=123456 ‘将数字123456命名为Total。

257个Excel宏常用语句1、打开全部隐藏工作表 (12)2、循环宏 (13)3、录制宏时调用“停止录制”工具栏 (13)4、高级筛选5列不重复数据至指定表 (13)5、双击单元执行宏(工作表代码) (13)6、双击指定区域单元执行宏(工作表代码) (14)7、进入单元执行宏(工作表代码) (14)8、进入指定区域单元执行宏(工作表代码) (15)9、在多个宏中依次循环执行一个（控件按钮代码） (15)10、在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码） (15)11、在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码） (16)12、根据A1单元文本隐藏/显示按钮（控件按钮代码） (16)13、当前单元返回按钮名称（控件按钮代码） (16)14、当前单元内容返回到按钮名称（控件按钮代码） (17)15、奇偶页分别打印 (17)16、自动打印多工作表第一页 (17)17、查找A列文本循环插入分页符 (18)18、将A列最后数据行以上的所有B列图片大小调整为所在单元大小 (18)19、返回光标所在行数 (19)20、在A1返回当前选中单元格数量 (19)21、返回当前工作簿中工作表数量 (19)22、返回光标选择区域的行数和列数 (19)23、工作表中包含数据的最大行数 (19)24、返回A列数据的最大行数 (19)25、将所选区域文本插入新建文本框 (20)26、批量插入地址批注 (20)27、批量插入统一批注 (20)28、以A1单元内容批量插入批注 (21)29、不连续区域插入当前文件名和表名及地址 (21)30、不连续区域录入当前单元地址 (21)31、连续区域录入当前单元地址 (21)32、返回当前单元地址 (22)33、不连续区域录入当前日期 (22)34、不连续区域录入当前数字日期 (22)35、不连续区域录入当前日期和时间 (22)36、不连续区域录入对勾 (22)37、不连续区域录入当前文件名 (22)38、不连续区域添加文本 (23)39、不连续区域插入文本 (23)40、从指定位置向下同时录入多单元指定内容 (23)41、按aa工作表A列的内容排列工作表标签顺序 (23)42、以A1单元文本作表名插入工作表 (24)43、删除全部未选定工作表 (24)44、工作表标签排序 (24)45、定义指定工作表标签颜色 (25)46、在目录表建立本工作簿中各表链接目录 (25)47、建立工作表文本目录 (26)48、查另一文件的全部表名 (26)49、当前单元录入计算机名 (26)50、当前单元录入计算机用户名 (27)51、解除全部工作表保护 (27)52、为指定工作表加指定密码保护表 (27)53、在有密码的工作表执行代码 (27)54、执行前需要验证密码的宏(控件按钮代码) (27)55、执行前需要验证密码的宏() (28)56、拷贝A1公式和格式到A2 (28)57、复制单元数值 (28)58、插入数值条件格式 (28)59、插入透明批注 (29)60、添加文本 (29)61、光标定位到指定工作表A列最后数据行下一单元 (29)62、定位选定单元格式相同的全部单元格 (29)63、按当前单元文本定位 (30)64、按固定文本定位 (31)65、删除包含固定文本单元的行或列 (31)66、定位数据及区域以上的空值 (31)67、右侧单元自动加5(工作表代码) (32)68、当前单元加2 (32)69、A列等于A列减B列 (32)70、用于光标选定多区域跳转指定单元(工作表代码) (32)71、将A1单元录入的数据累加到B1单元（工作表代码） (32)72、在指定颜色区域选择单元时添加/取消"√"（工作表代码） (33)73、在指定区域选择单元时添加/取消"√"（工作表代码） (33)74、双击指定单元，循环录入文本（工作表代码） (33)75、双击指定单元，循环录入文本（工作表代码） (34)76、单元区域引用（工作表代码） (34)77、在指定区域选择单元时数值加1（工作表代码） (34)78、混合文本的编号 (34)79、指定区域单元双击数据累加（工作表代码） (34)80、选择单元区域触发事件（工作表代码） (35)81、当修改指定单元内容时自动执行宏（工作表代码） (35)82、被指定单元内容限制执行宏 (35)83、双击单元隐藏该行（工作表代码） (35)84、高亮显示行（工作表代码） (35)85、高亮显示行和列（工作表代码） (35)86、为指定工作表设置滚动范围（工作簿代码） (36)87、在指定单元记录打印和预览次数（工作簿代码） (36)88、自动数字金额转大写（工作表代码） (36)89、将全部工作表的A1单元作为单击按钮（工作簿代码） (36)90、闹钟——到指定时间执行宏（工作簿代码） (36)91、改变Excel界面标题的宏（工作簿代码） (37)92、在指定工作表的指定单元返回光标当前多选区地址（工作簿代码） (37)93、B列录入数据时在A列返回记录时间（工作表代码） (37)94、当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码） (37)95、指定单元显示光标位置内容（工作表代码） (38)96、每编辑一个单元保存文件 (38)97、指定允许编辑区域 (38)98、解除允许编辑区域限制 (38)99、删除指定行 (38)100、删除A列为指定内容的行 (38)101、删除A列非数字单元行 (39)102、有条件删除当前行 (39)103、选择下一行 (39)104、选择第5行开始所有数据行 (39)105、选择光标或选区所在行 (40)106、选择光标或选区所在列 (40)107、光标定位到名称指定位置 (40)108、选择名称定义的数据区 (40)109、选择到指定列的最后行 (40)110、将Sheet1的A列的非空值写到Sheet2的A列 (40)111、将名称1的数据写到名称2 (41)112、单元反选 (41)113、调整选中对象中的文字 (41)114、去除指定范围内的对象 (41)115、更新透视表数据项 (42)116、将全部工作表名称写到A列 (42)117、为当前选定的多单元插入指定名称 (42)118、删除全部名称 (43)119、以指定区域为表目录补充新表 (43)120、按A列数据批量修改表名称 (43)121、按A列数据批量创建新表(控件按钮代码) (44)122、清除剪贴板 (44)123、批量清除软回车 (44)124、判断指定文件是否已经打开 (44)125、当前文件另存到指定目录 (45)126、另存指定文件名 (45)127、以本工作表名称另存文件到当前目录 (45)128、将本工作表单独另存文件到Excel当前默认目录 (45)129、以活动工作表名称另存文件到Excel当前默认目录 (45)130、另存所有工作表为工作簿 (45)131、以指定单元内容为新文件名另存文件 (46)132、以当前日期为新文件名另存文件 (46)133、以当前日期和时间为新文件名另存文件 (46)134、另存本表为TXT文件 (46)135、引用指定位置单元内容为部分文件名另存文件 (47)136、将A列数据排序到D列 (47)137、将指定范围的数据排列到D列 (47)138、光标所在行上移一行 (48)139、加数据有效限制 (48)140、取消数据有效限制 (48)141、重排窗口 (49)142、按当前单元文本选择打开指定文件单元 (49)143、回车光标向右 (49)144、回车光标向下 (49)145、保护工作表时取消选定锁定单元 (50)146、保存并退出Excel (50)147、隐藏/显示指定列空值行 (50)148、深度隐藏指定工作表 (50)149、隐藏指定工作表 (50)150、隐藏当前工作表 (50)151、返回当前工作表名称 (51)152、获取上一次所进入工作簿的工作表名称 (51)153、按光标选定颜色隐藏本列其他颜色行 (51)154、打开工作簿自动隐藏录入表以外的其他表 (51)155、除最左边工作表外深度隐藏所有表 (52)156、关闭文件时自动隐藏指定工作表(ThisWorkbook) (52)157、打开文件时提示指定工作表是保护状态(ThisWorkbook) (52)158、插入10行 (52)159、全选固定范围内小于0的单元 (52)160、全选选定范围内小于0的单元 (53)161、固定区域单元分类变色 (53)162、A列半角内容变红 (54)163、单元格录入数据时运行宏的代码 (54)164、根据B列最后数据快速合并A列单元格的控件代码 (54)165、在F1单元显示光标位置批注内容的代码 (55)166、显示光标所在单元的批注的代码 (55)167、使单元内容保持不变的工作表代码 (55)168、有条件执行宏 (55)169、有条件执行不同的宏 (55)170、提示确定或取消执行宏 (56)171、提示开始和结束 (56)172、拷贝指定表不相邻多列数据到新位置 (56)173、选择2至4行 (56)174、在当前选区有条件替换数值为文本 (56)175、自动筛选全部显示指定列 (57)176、自动筛选第2列值为A的行 (57)177、取消自动筛选() (57)178、全部显示指定表的自动筛选 (57)179、强行合并单元 (57)180、设置单元区域格式 (58)181、在所有工作表的A1单元返回顺序号 (58)182、根据A1单元内容返回C1数值 (58)183、根据A1内容选择执行宏 (58)184、删除A列空行 (59)185、在A列产生不重复随机数 (59)186、将A列数据随机排列到F列 (59)187、取消选定区域的公式只保留值(假空转真空) (60)188、处理导入的显示为科学计数法样式的身份证号 (60)189、返回指定单元的行高和列宽 (60)190、指定行高和列宽 (60)191、指定单元的行高和列宽与A1单元相同 (61)191、填公式 (61)192、建立当前工作表的副本为001表 (61)193、在第一个表前插入多工作表 (61)194、清除A列再插入序号 (61)195、反方向文本(自定义函数) (62)196、指定选择单元区域弹出消息 (62)197、将B列数据添加超链接到K列 (62)198、删除B列数据的超链接 (62)199、分离临时表A列数据的文本和超链接并整理到数据库表 (62)200、分离临时表A列数据的文本和超链接并会同其他数据整理到数据库表 (63)201、返回A列最后一个非空单元行号 (63)202、返回表中第一个非空单元地址(行搜索) (64)203、返回表中各非空单元区域地址(行搜索) (64)204、返回第一个数值行号 (64)205、返回第1行最右边非空单元的列号 (64)206、返回连续数值单元的数量 (64)207、统计指定范围和内容的单元数量 (64)208、统计不同颜色的数字的和（自定义函数） (65)209、返回非空单元数量 (65)210、返回A列非空单元数量 (65)211、返回圆周率π (65)212、定义指定单元内容为页眉/页脚 (65)213、提示并全部清除当前选择区域 (66)214、全部清除当前选择区域 (66)215、清除指定区域数值 (66)216、对指定工作表执行取消隐藏》打印》隐藏工作表 (66)217、打开文件时执行指定宏(工作簿代码) (66)218、关闭文件时执行指定宏(工作簿代码) (67)219、弹出提示A1单元内容 (67)220、延时15秒执行重排窗口宏 (67)221、撤消工作表保护并取消密码 (67)222、重算指定表 (67)223、将第5行移到窗口的最上面 (67)224、对第一张工作表的指定区域进行排序 (68)225、显示指定工作表的打印预览 (68)226、用单元格A1的内容作为文件名另存当前工作簿 (68)227、[禁用/启用]保存和另存的代码 (68)228、在A和B列返回当前选区的名称和公式 (68)229、朗读朗读A列,按ESC键中止 (68)230、朗读固定语句，请按ESC键终止 (69)231、在M和N列的14行以下选择单元时显示调用日历控件（工作表代码） (69)232、添加自定义序列 (70)233、弹出打印对话框 (70)234、返回总页码 (70)235、合并各工作表内容 (70)236、合并指定目录中所有文件中相同格式工作表的数据 (71)237、隐藏指定工作表的指定列 (72)238、把a列不重复值取到e列 (72)239、当前选区的行列数 (72)240、单元格录入1位字符就跳转(工作表代码) (73)241、当指定日期（每月10日）打开文件执行宏 (73)242、提示并清空单元区域 (73)243、返回光标所在行号 (73)244、按照当前行A列的图片名称插入图片到H列 (74)245、当前行下插入1行 (74)246、取消指定行或列的隐藏 (74)247、复制单元格所在行 (75)248、复制单元格所在列 (75)249、新建一个工作表 (75)250、新建一个工作簿 (75)251、选择多表为工作组 (75)252、在当前工作组各表中分别执行指定宏 (76)253、复制当前工作簿的报表到临时工作簿 (77)254、删除指定文件 (77)255、合并A1至C1的内容写到D15单元的批注中 (78)256、自动重算 (78)257、手动重算 (78)1、打开全部隐藏工作表Sub 打开全部隐藏工作表()Dim i As IntegerFor i = 1 To Sheets.CountSheets(i).Visible = TrueNext iEnd Sub2、循环宏Sub 循环()AAA = Range("C2")Dim i As LongDim times As Longtimes = AAA'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647) For i = 1 To timesCall 过滤一行If Range("完成标志") = "完成" ThenExit For'如果名为'完成标志'的命名单元的值等于'完成',则退出循环,如果一开始就等于'完成',则只执行一次循环就退出'If Sheets("传送参数").Range("A" & i).Text = "完成" Then Exit For'如果某列出现"完成"内容则退出循环Next iEnd Sub3、录制宏时调用“停止录制”工具栏Sub 录制宏时调用停止录制工具栏()mandBars("Stop Recording").Visible = TrueEnd Sub4、高级筛选5列不重复数据至指定表Sub 高级筛选5列不重复数据至Sheet2()Sheets("Sheet2").Range("A1:E65536") = "" '清除Sheet2的A:D列Range("A1:E65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheet2.Range( _ "A1"), Unique:=TrueSheet2.Columns("A:E").Sort Key1:=Sheet2.Range("A2"), Order1:=xlAscending,Header:=xlGuess, _OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _:=xlPinYinEnd Sub5、双击单元执行宏(工作表代码)Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Range("$A$1") = "关闭" ThenExit SubSelect Case Target.AddressCase "$A$4"Call 宏1Cancel = TrueCase "$B$4"Call 宏2Cancel = TrueCase "$C$4"Call 宏3Cancel = TrueCase "$E$4"Call 宏4Cancel = TrueEnd SelectEnd Sub6、双击指定区域单元执行宏(工作表代码)Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Range("$A$1") = "关闭" Then Exit SubIf Not Application.Intersect(Target, Range("A4:A9", "C4:C9")) Is Nothing Then Call 打开隐藏表End Sub7、进入单元执行宏(工作表代码)Private Sub Worksheet_SelectionChange(ByVal Target As Range)'以单元格进入代替按钮对象调用宏If Range("$A$1") = "关闭" Then Exit SubSelect Case Target.AddressCase "$A$5" '单元地址(Target.Address),或命名单元名字()Call 宏1Case "$B$5"Call 宏2Case "$C$5"Call 宏3End SelectEnd Sub8、进入指定区域单元执行宏(工作表代码)Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Range("$A$1") = "关闭" Then Exit SubIf Not Application.Intersect(Target, Range("A4:A9","C4:C9")) Is Nothing Then Call 打开隐藏表End Sub9、在多个宏中依次循环执行一个（控件按钮代码）Private Sub CommandButton1_Click()Static RunMacro As IntegerSelect Case RunMacroCase 0宏1RunMacro = 1Case 1宏2RunMacro = 2Case 2宏3RunMacro = 0End SelectEnd Sub10、在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Private Sub CommandButton1_Click()With CommandButton1If .Caption = "保护工作表" ThenCall 保护工作表.Caption = "取消工作表保护"Exit SubEnd IfIf .Caption = "取消工作表保护" ThenCall 取消工作表保护.Caption = "保护工作表"Exit SubEnd IfEnd WithEnd Sub11、在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Option ExplicitPrivate Sub CommandButton1_Click()With CommandButton1If .Caption = "宏1" ThenCall 宏1.Caption = "宏2"Exit SubEnd IfIf .Caption = "宏2" ThenCall 宏2.Caption = "宏3"Exit SubEnd IfIf .Caption = "宏3" ThenCall 宏3.Caption = "宏1"Exit SubEnd IfEnd WithEnd Sub12、根据A1单元文本隐藏/显示按钮（控件按钮代码）Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Range("A1") > 2 ThenCommandButton1.Visible = 1ElseCommandButton1.Visible = 0End IfEnd SubPrivate Sub CommandButton1_Click()重排窗口End Sub13、当前单元返回按钮名称（控件按钮代码）Private Sub CommandButton1_Click()ActiveCell = CommandButton1.CaptionEnd Sub14、当前单元内容返回到按钮名称（控件按钮代码）Private Sub CommandButton1_Click()CommandButton1.Caption = ActiveCellEnd Sub15、奇偶页分别打印Sub 奇偶页分别打印()Dim i%, Ps%Ps = ExecuteExcel4Macro("GET.DOCUMENT(50)") '总页数MsgBox "现在打印奇数页,按确定开始."For i = 1 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iMsgBox "现在打印偶数页,按确定开始."For i = 2 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iEnd Sub16、自动打印多工作表第一页Sub 自动打印多工作表第一页()Dim sh As IntegerDim xDim yDim syDim syzx = InputBox("请输入起始工作表名字:")sy = InputBox("请输入结束工作表名字:")y = Sheets(x).Indexsyz = Sheets(sy).IndexFor sh = y To syzSheets(sh).SelectSheets(sh).PrintOut from:=1, To:=1Next shEnd Sub17、查找A列文本循环插入分页符Sub 循环插入分页符()' Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容Dim i As LongDim times As Longtimes = Application.WorksheetFunction.CountIf(Sheet1.Range("a:a"), "分页") 'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647) For i = 1 To timesCall 插入分页符Next iEnd SubSub 插入分页符()Cells.Find(What:="分页", After:=ActiveCell, LookIn:=xlValues, LookAt:= _xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _.ActivateActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCellEnd SubSub 取消原分页()Cells.SelectActiveSheet.ResetAllPageBreaksEnd Sub18、将A列最后数据行以上的所有B列图片大小调整为所在单元大小Sub 将A列最后数据行以上的所有B列图片大小调整为所在单元大小() Dim Pic As Picture, i&i = [A65536].End(xlUp).RowFor Each Pic In Sheet1.PicturesIf Not Application.Intersect(Pic.TopLeftCell, Range("B1:B" & i)) Is Nothing Then Pic.Top = Pic.TopLeftCell.TopPic.Left = Pic.TopLeftCell.LeftPic.Height = Pic.TopLeftCell.HeightPic.Width = Pic.TopLeftCell.WidthEnd IfNextEnd Sub19、返回光标所在行数Sub 返回光标所在行数()x = ActiveCell.RowRange("A1") = xEnd Sub20、在A1返回当前选中单元格数量Sub 在A1返回当前选中单元格数量()[A1] = Selection.CountEnd Sub21、返回当前工作簿中工作表数量Sub 返回当前工作簿中工作表数量()t = Application.Sheets.CountMsgBox tEnd Sub22、返回光标选择区域的行数和列数Sub 返回光标选择区域的行数和列数()x = Selection.Rows.County = Selection.Columns.CountRange("A1") = xRange("A2") = yEnd Sub23、工作表中包含数据的最大行数Sub 包含数据的最大行数()n = Cells.Find("*", , , , 1, 2).RowMsgBox nEnd Sub24、返回A列数据的最大行数Sub 返回A列数据的最大行数()n = Range("a65536").End(xlUp).RowRange("B1") = nEnd Sub25、将所选区域文本插入新建文本框Sub 将所选区域文本插入新建文本框()For Each rag In Selectionn = n & rag.Value & Chr(10)NextActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, ActiveCell.Left + ActiveCell.Width, ActiveCell.Top + ActiveCell.Height, 250#, 100).SelectSelection.Characters.Text = "问题：" & nWith Selection.Characters(Start:=1, Length:=3).Font.Name = "黑体".FontStyle = "常规".Size = 12End WithEnd Sub26、批量插入地址批注Sub 批量插入地址批注()On Error Resume NextDim r As RangeIf Selection.Cells.Count > 0 ThenFor Each r In Selectionment.Deleter.AddCommentment.Visible = Falsement.Text Text:="本单元格：" & r.Address & " of " & Selection.Address NextEnd IfEnd Sub27、批量插入统一批注Sub 批量插入统一批注()Dim r As Range, msg As Stringmsg = InputBox("请输入欲批量插入的批注", "提示", "随便输点什么吧")If Selection.Cells.Count > 0 ThenFor Each r In Selectionr.AddCommentment.Visible = Falsement.Text Text:=msgNextEnd IfEnd Sub28、以A1单元内容批量插入批注Sub 以A1单元内容批量插入批注()Dim r As RangeIf Selection.Cells.Count > 0 ThenFor Each r In Selectionr.AddCommentment.Visible = Falsement.Text Text:=[a1].TextNextEnd IfEnd Sub29、不连续区域插入当前文件名和表名及地址Sub 批量插入当前文件名和表名及地址()For Each mycell In Selectionmycell.FormulaR1C1 = "[" + + "]" + + "!" + mycell.AddressNextEnd Sub30、不连续区域录入当前单元地址Sub 区域录入当前单元地址()For Each mycell In Selectionmycell.FormulaR1C1 = mycell.AddressNextEnd Sub31、连续区域录入当前单元地址Sub 连续区域录入当前单元地址()Selection = "=ADDRESS(ROW(),COLUMN(),4,1)"Selection.CopySelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=FalseEnd Sub32、返回当前单元地址Sub 返回当前单元地址()d = ActiveCell.Address[A1] = dEnd Sub33、不连续区域录入当前日期Sub 区域录入当前日期()Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d")End Sub34、不连续区域录入当前数字日期Sub 区域录入当前数字日期()Selection.FormulaR1C1 = Format(Now(), "yyyymmdd")End Sub35、不连续区域录入当前日期和时间Sub 区域录入当前日期和时间()Selection.FormulaR1C1 = Format(Now(), "yyyy-m-d h:mm:ss") End Sub36、不连续区域录入对勾Sub 批量录入对勾()Selection.FormulaR1C1 = "√"End Sub37、不连续区域录入当前文件名Sub 批量录入当前文件名()Selection.FormulaR1C1 = End Sub38、不连续区域添加文本Sub 批量添加文本()Dim s As RangeFor Each s In Selections = s & "文本内容"NextEnd Sub39、不连续区域插入文本Sub 批量插入文本()Dim s As RangeFor Each s In Selections = "文本内容" & sNextEnd Sub40、从指定位置向下同时录入多单元指定内容Sub 从指定位置向下同时录入多单元指定内容()Dim arrarr = Array("1", "2", "13", "25", "46", "12", "0", "20")[B2].Resize(8, 1) = Application.WorksheetFunction.Transpose(arr) End Sub41、按aa工作表A列的内容排列工作表标签顺序Sub 按aa工作表A列的内容排列工作表标签顺序()Dim I%, str1$I = 1Sheets("aa").SelectDo While Cells(I, 1).Value <> ""str1 = Trim(Cells(I, 1).Value)Sheets(str1).SelectSheets(str1).Move after:=Sheets(I)I = I + 1Sheets("aa").SelectLoopEnd Sub42、以A1单元文本作表名插入工作表Sub 以A1单元文本作表名插入工作表()Dim nm As Stringnm = [a1]Sheets.Add = nmEnd Sub43、删除全部未选定工作表Sub 删除全部未选定工作表()Dim sht As Worksheet, n As Integer, iFlag As BooleanDim ShtName() As Stringn = ActiveWindow.SelectedSheets.CountReDim ShtName(1 To n)n = 1For Each sht In ActiveWindow.SelectedSheetsShtName(n) = n = n + 1NextApplication.DisplayAlerts = FalseFor Each sht In SheetsiFlag = FalseFor i = 1 To n - 1If ShtName(i) = TheniFlag = TrueExit ForEnd IfNextIf Not iFlag Then sht.DeleteNextApplication.DisplayAlerts = TrueEnd Sub44、工作表标签排序Sub 工作表标签排序()Dim i As Long, j As Long, nums As Long, msg As Longmsg = MsgBox("工作表按升序排列请选'是[Y]'. " & vbCrLf & vbCrLf & "工作表按降序排列请选'否[N]'", vbYesNoCancel, "工作表排序")If msg = vbCancel Then Exit Subnums = Sheets.CountIf msg = vbYes Then 'Sort ascendingFor i = 1 To numsFor j = i To numsIf UCase(Sheets(j).Name) < UCase(Sheets(i).Name) ThenSheets(j).Move Before:=Sheets(i)End IfNext jNext iElse 'Sort descendingFor i = 1 To numsFor j = i To numsIf UCase(Sheets(j).Name) > UCase(Sheets(i).Name) ThenSheets(j).Move Before:=Sheets(i)End IfNext jNext iEnd IfEnd Sub45、定义指定工作表标签颜色Sub 定义指定工作表标签颜色()Sheets("Sheet1").Tab.ColorIndex = 46End Sub46、在目录表建立本工作簿中各表链接目录Sub 在目录表建立本工作簿中各表链接目录()Dim s%, Rng As RangeOn Error Resume NextSheets("目录").ActivateIf Err = 0 ThenSheets("目录").UsedRange.DeleteElseSheets.Add = "目录"End IfFor i = 1 To Sheets.CountIf Sheets(i).Name <> "目录" Thens = s + 1Set Rng = Sheets("目录").Cells(((s - 1) Mod 20) + 1, (s - 1) \ 20 + 1 + 1)Rng = Format(s, " 0") & ". " & Sheets(i).NameActiveSheet.Hyperlinks.Add Rng, "#" & Sheets(i).Name & "!A1", ScreenTip:=Sheets(i).NameEnd IfNextSheets("目录").Range("b:iv").EntireColumn.ColumnWidth = 20End Sub47、建立工作表文本目录Sub 建立工作表文本目录()Sheets.Add before:=Sheets(1)Sheets(1).Name = "目录"For i = 2 To Sheets.CountCells(i - 1, 1) = Sheets(i).Name'Sheets(1).Hyperlinks.Add Cells(i - 1, 1), "#" & Sheets(i).Name & "!A1" '添加超链接NextEnd Sub48、查另一文件的全部表名Sub 查另一文件的全部表名()On Error Resume NextDim i%Dim sh As WorksheetApplication.ScreenUpdating = FalseWorkbooks.Open Filename:=ThisWorkbook.Path & "\2.xls"Windows("1.xls").Activate '当前文件名称Sheets("Sheet1").Select '当前表名称i = 1 '将表名称返回到第1行For Each sh In Workbooks("2.xls").WorksheetsCells(i, 1) = '将表名称返回到第1列i = i + 1 '返回每个表名称向下移动1行Next shWindows("2.xls").Close '关闭对象文件Application.ScreenUpdating = TrueEnd Sub49、当前单元录入计算机名Sub 当前单元录入计算机名()Selection = Environ("COMPUTERNAME")'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub50、当前单元录入计算机用户名Sub 当前单元录入计算机用户名()Selection = Environ("Username")'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub51、解除全部工作表保护Sub 解除全部工作表保护()Dim n As IntegerFor n = 1 To Sheets.CountSheets(n).UnprotectNext nEnd Sub52、为指定工作表加指定密码保护表Sub 为指定工作表加指定密码保护表()Sheet10.Protect Password:="123"End Sub53、在有密码的工作表执行代码Sub 在有密码的工作表执行代码()Sheets("1").Unprotect Password:=123 '假定表名为“1”，密码为“123”打开工作表Range("C:C").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True '隐藏C列空值行Sheets("1").Protect Password:=123 '重新用密码保护工作表End Sub54、执行前需要验证密码的宏(控件按钮代码)Private Sub CommandButton1_Click()If InputBox("请输入密码：") <> "123" Then '密码是123MsgBox "密码错误,按确定退出!", 64, "提示"Exit SubEnd IfCells(1, 1) = 10End Sub55、执行前需要验证密码的宏()Sub 执行前需要验证密码的宏()If InputBox("请输入您的使用权限:", "系统提示") = 123 Then重排窗口'要执行的宏代码或宏名称ElseMsgBox "对不起,您没有使用该宏的权限,按确定键后退出!"End IfEnd Sub56、拷贝A1公式和格式到A2Sub 拷贝A1公式到A2()Workbooks("临时表").Sheets("表1").Range("A1").CopyWorkbooks("临时表").Sheets("表2").Range("A2").PasteSpecialEnd Sub57、复制单元数值Sub 复制数值()s = Workbooks("book1").Sheets("Sheet1").Range("A1:A2")Workbooks("book2").Sheets("Sheet1").Range("A1:A2") = sEnd Sub58、插入数值条件格式Sub 插入数值条件格式()Selection.FormatConditions.DeleteSelection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _ Formula1:="70"Selection.FormatConditions(1).Interior.ColorIndex = 45Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _ Formula1:="55"Selection.FormatConditions(2).Interior.ColorIndex = 39Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlGreater, _ Formula1:="60"Selection.FormatConditions(3).Interior.ColorIndex = 34End Sub59、插入透明批注Sub 插入透明批注()Selection.AddCommentment.Visible = FalseDim XS As WorksheetFor i = 1 To ments.Countments(i).Text "透明批注"ments(i).Shape.Fill.Visible = msoFalseNextEnd Sub60、添加文本Sub 添加文本()Selection = Selection + "×" '不可在数字后添加文本'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub61、光标定位到指定工作表A列最后数据行下一单元Sub 光标定位到指定工作表A列最后数据行下一单元()a = Sheets("数据库").[a65536].End(xlUp).RowSheets("数据库").SelectRange("A" & a + 1).SelectEnd Sub62、定位选定单元格式相同的全部单元格Sub 定位选定单元格式相同的全部单元格()Dim FirstCell As Range, FoundCell As RangeDim AllCells As RangeWith Application.FindFormat.Clear.NumberFormatLocal = Selection.NumberFormatLocal.HorizontalAlignment = Selection.HorizontalAlignment.VerticalAlignment = Selection.VerticalAlignment.WrapText = Selection.WrapText.Orientation = Selection.Orientation.AddIndent = Selection.AddIndent.IndentLevel = Selection.IndentLevel.ShrinkToFit = Selection.ShrinkToFit.MergeCells = Selection.MergeCells = .Font.FontStyle = Selection.Font.FontStyle.Font.Size = Selection.Font.Size.Font.Strikethrough = Selection.Font.Strikethrough.Font.Subscript = Selection.Font.Subscript.Font.Underline = Selection.Font.Underline.Font.ColorIndex = Selection.Font.ColorIndex.Interior.ColorIndex = Selection.Interior.ColorIndex.Interior.Pattern = Selection.Interior.Pattern.Locked = Selection.Locked.FormulaHidden = Selection.FormulaHiddenEnd WithSet FirstCell = edRange.Find(what:="", searchformat:=True)If FirstCell Is Nothing ThenExit SubEnd IfSet AllCells = FirstCellSet FoundCell = FirstCellDoSet FoundCell = edRange.Find(After:=FoundCell, what:="", searchformat:=True)If FoundCell Is Nothing Then Exit DoSet AllCells = Union(FoundCell, AllCells)If FoundCell.Address = FirstCell.Address Then Exit DoLoopAllCells.SelectEnd Sub63、按当前单元文本定位Sub 按当前单元文本定位()ABC = SelectionDim aa As RangeFor Each a In edRangeIf a Like ABC ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.Cells)End IfEnd IfNextaa.SelectEnd Sub64、按固定文本定位Sub 文本定位()Dim aa As RangeFor Each a In edRangeIf a Like "*合计*" ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.Cells)End IfEnd IfNextaa.SelectEnd Sub65、删除包含固定文本单元的行或列Sub 删除包含固定文本单元的行或列()DoCells.Find(what:="哈哈").ActivateSelection.EntireRow.Delete '删除行' Selection.EntireColumn.Delete '删除列Loop Until Cells.Find(what:="哈哈") Is Nothing End Sub66、定位数据及区域以上的空值Sub 定位数据及区域以上的空值()Dim aa As RangeFor Each a In edRangeIf a Like 〈0 ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.Cells)End IfEnd IfNextaa.SelectEnd Sub67、右侧单元自动加5(工作表代码)Private Sub Worksheet_Change(ByVal Target As Range)Application.EnableEvents = FalseTarget.Offset(0, 1) = Target + 5Application.EnableEvents = TrueEnd Sub68、当前单元加2Sub 当前单元加2()Selection = Selection + 2'Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容End Sub69、A列等于A列减B列Sub A列等于A列减B列()For i = 1 To 23Cells(i, 1) = Cells(i, 1) - Cells(i, 2)NextEnd Sub70、用于光标选定多区域跳转指定单元(工作表代码)Private Sub Worksheet_SelectionChange(ByVal T As Range)a = Array([b6:b7], [e6], [h6])For i = 0 To 2If Not Application.Intersect(T, a(i)) Is Nothing Then[a1].Select: Exit ForEnd IfNextEnd Sub71、将A1单元录入的数据累加到B1单元（工作表代码）Private Sub Worksheet_Change(ByVal Target As Range)Dim t As LongIf Target.Address = "$A$1" Thent = Sheet1.Range("$B$1").ValueSheet1.Range("$B$1").Value = t + Target.ValueEnd IfEnd Sub72、在指定颜色区域选择单元时添加/取消"√"（工作表代码）Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim myrg As RangeFor Each myrg In TargetIf myrg.Interior.ColorIndex = 37 Then myrg = IIf(myrg <> "√", "√", "") NextEnd Sub73、在指定区域选择单元时添加/取消"√"（工作表代码）Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim Rng As RangeIf Target.Count <= 15 ThenIf Not Application.Intersect(Target, Range("D6:D20")) Is Nothing Then For Each Rng In SelectionWith RngIf .Value = "" Then.Value = "√"Else.Value = ""End IfEnd WithNextEnd IfEnd IfEnd Sub74、双击指定单元，循环录入文本（工作表代码）Private Sub Worksheet_BeforeDoubleClick(ByVal T As Range, Cancel As Boolean)If T.Address <> "$A$1" Then Exit SubCancel = TrueT = IIf(T = "好", "中", IIf(T = "中", "差", "好"))End Sub75、双击指定单元，循环录入文本（工作表代码）Dim nums As BytePrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Target.Address = "$A$1" Thennums = nums Mod 3 + 1Target = Mid("上中下", nums, 1)Target.Offset(1, 0).SelectEnd IfEnd Sub76、单元区域引用（工作表代码）Private Sub Worksheet_Activate()Sheet1.Range("A1:B3").Value = Sheet2.Range("A1:B3").ValueEnd Sub77、在指定区域选择单元时数值加1（工作表代码）Private Sub Worksheet_SelectionChange(ByVal Target As Range)If Not Application.Intersect([a1:e10], Target) Is Nothing ThenTarget = Val(Target) + 1End IfEnd Sub78、混合文本的编号Sub 混合文本的编号()Worksheets(1).Range("B2").Value = "北京" & (--(Mid(Worksheets(1).Range("B2"), 3, 100)) + 1) End Sub79、指定区域单元双击数据累加（工作表代码）Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Not Application.Intersect([A1:Y100], Target) Is Nothing Thenoldvalue = Val(Target.Value)inputvalue = InputBox("请输入数量,按ENTER键确认!", "数值累加器")Target.Value = oldvalue + inputvalueEnd IfEnd Sub。

Excel之VBA编程常用语句300句定制模块行为(1) Option Explicit '强制对模块内所有变量进行声明Option Private Module '标记模块为私有，仅对同一工程中其它模块有用，在宏对话框中不显示Option Compare Text '字符串不区分大小写Option Base 1 '指定数组的第一个下标为1(2) On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息(3) On Error GoTo ErrorHandler '当错误发生时跳转到过程中的某个位置(4) On Error GoTo 0 '恢复正常的错误提示(5) Application.DisplayAlerts=False '在程序执行过程中使出现的警告框不显示(6) Application.ScreenUpdating=False '关闭屏幕刷新Application.ScreenUpdating=True '打开屏幕刷新(7) Application.Enable.CancelKey=xlDisabled '禁用Ctrl+Break中止宏运行的功能工作簿(8) Workbooks.Add() '创建一个新的工作簿(9) Workbooks(“book1.xls”).Activate '激活名为book1的工作簿(10) ThisWorkbook.Save '保存工作簿(11) ThisWorkbook.close '关闭当前工作簿(12) ActiveWorkbook.Sheets.Count '获取活动工作薄中工作表数(13) '返回活动工作薄的名称(14) ThisWorkbook.N ame ‘返回当前工作簿名称ThisWorkbook.FullName ‘返回当前工作簿路径和名称(15) ActiveWindow.EnableResize=False ‘禁止调整活动工作簿的大小(16) Application.Window.Arrange xlArrangeStyleTiled ‘将工作簿以平铺方式排列(17) ActiveWorkbook.WindowState=xlMaximized ‘将当前工作簿最大化工作表(18) edRange.Ro ws.Count ‘当前工作表中已使用的行数(19) Rows.Count ‘获取工作表的行数(注：考虑向前兼容性)(20) Sheets(Sheet1).Name= “Sum” '将Sheet1命名为Sum(21) ThisWorkbook.Sheets.Add Before:=Worksheets(1) '添加一个新工作表在第一工作表前(22) ActiveSheet.Move After:=ActiveWorkbook. _Sheets(ActiveWorkbook.Sheets.Count) '将当前工作表移至工作表的最后(23) Worksheets(Array(“sheet1”,”sheet2”)).Select '同时选择工作表1和工作表2(24) Sheets(“sheet1”).Delete或 Sheets(1).Delete '删除工作表1(25) ActiveWorkbook.Sheets(i).Name '获取工作表i的名称(26) ActiveWindow.DisplayGridlines=Not ActiveWindow.DisplayGridlines '切换工作表中的网格线显示，这种方法也可以用在其它方面进行相互切换，即相当于开关按钮(27) ActiveWindow.DisplayHeadings=Not ActiveWindow.DisplayHeadings‘切换工作表中的行列边框显示(28) edRange.FormatConditions.Delete ‘删除当前工作表中所有的条件格式(29) Cells.Hyperlinks.Delete ‘取消当前工作表所有超链接(30) ActiveSheet.PageSetup.Orientation=xlLandscape或ActiveSheet.PageSetup.Orientation=2 '将页面设置更改为横向(31) ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName ‘在页面设置的表尾中输入文件路径ActiveSheet.PageSetup.LeftFooter=erName ‘将用户名放置在活动工作表的页脚单元格/单元格区域(32) ActiveCell.CurrentRegion.Select或Range(ActiveCell.End(xlUp),ActiveCell.End(xlDown)).Select'选择当前活动单元格所包含的范围，上下左右无空行(33) Cells.Select ‘选定当前工作表的所有单元格(34) Range(“A1”).ClearContents '清除活动工作表上单元格A1中的内容Selection.ClearContents '清除选定区域内容Range(“A1:D4”).Clear '彻底清除A1至D4单元格区域的内容，包括格式(35) Cells.Clear '清除工作表中所有单元格的内容(36) ActiveCell.Offset(1,0).Select '活动单元格下移一行，同理，可下移一列(37) Range(“A1”).Offset(ColumnOffset:=1)或Range(“A1”).Offset(,1) ‘偏移一列Range(“A1”).Offset(Rowoffset:=-1)或Range(“A1”).Offset(-1) ‘向上偏移一行(38) Range(“A1”).Copy Range(“B1”) '复制单元格A1，粘贴到单元格B1中Range(“A1:D8”).Copy Range(“F1”) '将单元格区域复制到单元格F1开始的区域中Range(“A1:D8”).Cut Range(“F1”) '剪切单元格区域A1至D8，复制到单元格F1开始的区域中Range(“A1”).CurrentRegion.Copy Sheets(“Sheet2”).Range(“A1”) '复制包含A1的单元格区域到工作表2中以A1起始的单元格区域中注：CurrentRegion属性等价于定位命令，由一个矩形单元格块组成，周围是一个或多个空行或列(39) ActiveWindow.RangeSelection.Value=XX '将值XX输入到所选单元格区域中(40) ActiveWindow.RangeSelection.Count '活动窗口中选择的单元格数(41) Selection.Count '当前选中区域的单元格数(42)GetAddress=Replace(Hyperlinkcell.Hyperlinks(1).Address,mailto:,””) ‘返回单元格中超级链接的地址并赋值(43) TextColor=Range(“A1”).Font.ColorIndex ‘检查单元格A1的文本颜色并返回颜色索引Range(“A1”).Interior.ColorIndex ‘获取单元格A1背景色(44) cells.count ‘返回当前工作表的单元格数(45) Selection.Range(“E4”).Select ‘激活当前活动单元格下方3行，向右4列的单元格(46) Cells.Item(5,”C”) ‘引单元格C5Cells.Item(5,3) ‘引单元格C5(47) Range(“A1”).Offset(RowOffset:=4,ColumnOffset:=5)或Range(“A1”).Offset(4,5) ‘指定单元格F5(48) Range(“B3”).Resize(RowSize:=11,ColumnSize:=3)Rnage(“B3”).Resize(11,3) ‘创建B3：D13区域(49) Range(“Data”).Resize(,2) ‘将Data区域扩充2列(50) Union(Range(“Data1”),Range(“Data2”)) ‘将Data1和Data2区域连接(51) Intersect(Range(“Data1”),Range(“Data2”)) ‘返回Data1和Data2区域的交叉区域(52) Range(“Data”).Count ‘单元格区域Data中的单元格数Range(“Data”). Columns.Count ‘单元格区域Data中的列数Range(“Data”). Rows.Count ‘单元格区域Data中的行数(53) Selection.Columns.Count ‘当前选中的单元格区域中的列数Selection.Rows.Count ‘当前选中的单元格区域中的行数(54) Selection.Areas.Count ‘选中的单元格区域所包含的区域数(55) edRange.Row ‘获取单元格区域中使用的第一行的行号(56) Rng.Column ‘获取单元格区域Rng左上角单元格所在列编号(57) ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions)‘在活动工作表中返回所有符合条件格式设置的区域(58) Range(“A1”).AutoFilter Field:=3,VisibleDropDown:=False ‘关闭由于执行自动筛选命令产生的第3个字段的下拉列表名称(59) Range(“A1：C3”).Name=“computer” ‘命名A1：C3区域为computer 或Range(“D1：E6”).Name=“Sheet1!book” ‘命名局部变量，即Sheet1上区域D1：E6为book或Names(“computer”).Name=“robot” ‘将区域computer重命名为robot(60) Names(“book”).Delete ‘删除名称(61) Names.Add Name:=“ContentList”，_RefersTo:=“=OFFSET(Sheet1!A2,0,0,COUNTA(Sheet2!$A:$A))” ‘动态命名(62) Names.Add Name:=“Company”,RefersTo:=“CompanyCar” ‘命名字符串CompanyCar(63) Names.Add Name:=“Total”,RefersTo:=123456 ‘将数字123456命名为Total。

EXCEL VBA常用语句100句（1）定制模块行为(1) Option Explicit '强制对模块内所有变量进行声明Option Private Module '标记模块为私有，仅对同一工程中其它模块有用，在宏对话框中不显示Option Compare Text '字符串不区分大小写Option Base 1 '指定数组的第一个下标为1(2) On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息(3) On Error GoTo ErrorHandler '当错误发生时跳转到过程中的某个位置(4) On Error GoTo 0 '恢复正常的错误提示(5) Application.DisplayAlerts=False '在程序执行过程中使出现的警告框不显示(6) Application.ScreenUpdating=False '关闭屏幕刷新Application.ScreenUpdating=True '打开屏幕刷新(7) Application.Enable.CancelKey=xlDisabled '禁用Ctrl+Break中止宏运行的功能工作簿(8) Workbooks.Add() '创建一个新的工作簿(9) Workbooks(“book1.xls”).Activate '激活名为book1的工作簿(10) ThisWorkbook.Save '保存工作簿(11) ThisWorkbook.close '关闭当前工作簿(12) ActiveWorkbook.Sheets.Count '获取活动工作薄中工作表数(13) '返回活动工作薄的名称(14) ‘返回当前工作簿名称ThisWorkbook.FullName ‘返回当前工作簿路径和名称(15) ActiveWindow.EnableResize=False ‘禁止调整活动工作簿的大小(16) Application.Window.Arrange xlArrangeStyleTiled ‘将工作簿以平铺方式排列(17) ActiveWorkbook.WindowState=xlMaximized ‘将当前工作簿最大化工作表(18) edRange.Rows.Count ‘当前工作表中已使用的行数(19) Rows.Count ‘获取工作表的行数(注：考虑向前兼容性)(20) Sheets(Sheet1).Name= “Sum”'将Sheet1命名为Sum(21) ThisWorkbook.Sheets.Add Before:=Worksheets(1) '添加一个新工作表在第一工作表前(22) ActiveSheet.Move After:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count) '将当前工作表移至工作表的最后(23) Worksheets(Array(“sheet1”,”sheet2”)).Select '同时选择工作表1和工作表2(24) Sheets(“sheet1”).Delete或Sheets(1).Delete '删除工作表1(25) ActiveWorkbook.Sheets(i).Name '获取工作表i的名称(26) ActiveWindow.DisplayGridlines=Not ActiveWindow.DisplayGridlines '切换工作表中的网格线显示，这种方法也可以用在其它方面进行相互切换，即相当于开关按钮(27) ActiveWindow.DisplayHeadings=Not ActiveWindow.DisplayHeadings ‘切换工作表中的行列边框显示(28) edRange.FormatConditions.Delete ‘删除当前工作表中所有的条件格式(29) Cells.Hyperlinks.Delete ‘取消当前工作表所有超链接(30) ActiveSheet.PageSetup.Orientation=xlLandscape或ActiveSheet.PageSetup.Orientation=2 '将页面设置更改为横向(31) ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName ‘在页面设置的表尾中输入文件路径ActiveSheet.PageSetup.LeftFooter=erName ‘将用户名放置在活动工作表的页脚单元格/单元格区域(32) ActiveCell.CurrentRegion.Select或Range(ActiveCell.End(xlUp),ActiveCell.End(xlDown)).Select'选择当前活动单元格所包含的范围，上下左右无空行(33) Cells.Select ‘选定当前工作表的所有单元格(34) Range(“A1”).ClearContents '清除活动工作表上单元格A1中的内容Selection.ClearContents '清除选定区域内容Range(“A1:D4”).Clear '彻底清除A1至D4单元格区域的内容，包括格式(35) Cells.Clear '清除工作表中所有单元格的内容(36) ActiveCell.Offset(1,0).Select '活动单元格下移一行，同理，可下移一列(37) Range(“A1”).Offset(ColumnOffset:=1)或Range(“A1”).Offset(,1) ‘偏移一列Range(“A1”).Offset(Rowoffset:=-1)或Range(“A1”).Offset(-1) ‘向上偏移一行(38) Range(“A1”).Copy Range(“B1”) '复制单元格A1，粘贴到单元格B1中Range(“A1:D8”).Copy Range(“F1”) '将单元格区域复制到单元格F1开始的区域中Range(“A1:D8”).Cut Range(“F1”) '剪切单元格区域A1至D8，复制到单元格F1开始的区域中Range(“A1”).CurrentRegion.Copy Sheets(“Sheet2”).Range(“A1”) '复制包含A1的单元格区域到工作表2中以A1起始的单元格区域中注：CurrentRegion属性等价于定位命令，由一个矩形单元格块组成，周围是一个或多个空行或列(39) ActiveWindow.RangeSelection.Value=XX '将值XX输入到所选单元格区域中(40) ActiveWindow.RangeSelection.Count '活动窗口中选择的单元格数(41) Selection.Count '当前选中区域的单元格数(42) GetAddress=Replace(Hyperlinkcell.Hyperlinks(1).Address,mailto:,””) ‘返回单元格中超级链接的地址并赋值(43) TextColor=Range(“A1”).Font.ColorIndex ‘检查单元格A1的文本颜色并返回颜色索引Range(“A1”).Interior.ColorIndex ‘获取单元格A1背景色(44) cells.count ‘返回当前工作表的单元格数(45) Selection.Range(“E4”).Select ‘激活当前活动单元格下方3行，向右4列的单元格(46) Cells.Item(5,”C”) ‘引单元格C5Cells.Item(5,3) ‘引单元格C5(47) Range(“A1”).Offset(RowOffset:=4,ColumnOffset:=5)或Range(“A1”).Offset(4,5) ‘指定单元格F5(48) Range(“B3”).Resize(RowSize:=11,ColumnSize:=3)Rnage(“B3”).Resize(11,3) ‘创建B3：D13区域(49) Range(“Data”).Resize(,2) ‘将Data区域扩充2列(50) Union(Range(“Data1”),Range(“Data2”)) ‘将Data1和Data2区域连接(51) Intersect(Range(“Data1”),Range(“Data2”)) ‘返回Data1和Data2区域的交叉区域(52) Range(“Data”).Count ‘单元格区域Data中的单元格数Range(“Data”). Columns.Count ‘单元格区域Data中的列数Range(“Data”). Rows.Count ‘单元格区域Data中的行数(53) Selection.Columns.Count ‘当前选中的单元格区域中的列数Selection.Rows.Count ‘当前选中的单元格区域中的行数(54) Selection.Areas.Count ‘选中的单元格区域所包含的区域数(55) edRange.Row ‘获取单元格区域中使用的第一行的行号(56) Rng.Column ‘获取单元格区域Rng左上角单元格所在列编号(57) ActiveSheet.Cells.SpecialCells(xlCellTypeAllFormatConditions) ‘在活动工作表中返回所有符合条件格式设置的区域(58) Range(“A1”).AutoFilter Field:=3,VisibleDropDown:=False ‘关闭由于执行自动筛选命令产生的第3个字段的下拉列表名称(59) Range(“A1：C3”).Name=“computer”‘命名A1：C3区域为computer或Range(“D1：E6”).Name=“Sheet1!book”‘命名局部变量，即Sheet1上区域D1：E6为book或Names(“computer”).Name=“robot”‘将区域computer重命名为robot(60) Names(“book”).Delete ‘删除名称(61) Names.Add Name:=“ContentList”，_RefersTo:=“=OFFSET(Sheet1!A2,0,0,COUNTA(Sheet2!$A:$A))”‘动态命名列(62) Names.Add Name:=“Company”,RefersTo:=“CompanyCar”‘命名字符串CompanyCar(63) Names.Add Name:=“Total”,RefersTo:=123456 ‘将数字123456命名为Total。

EXCELVBA常用代码集1.显示活动工作簿名称MsgBox "当前活动工作簿是" & 2.保存活动工作簿Activeworkbook.Save3.保存所有打开的工作簿关闭EXCELFor Each W in Application.WorkbooksW.SaveNext WApplication.Quit4.将网格线设置为蓝色ActiveWindow.GridlineColorIndex = 55.将工作表sheet1隐藏Sheet1.Visible = xlSheetVeryHidden6.将工作表Shtte1显示Sheet1.Visible = xlSheetVisible7.单击某单元格,该单元格所在的行以蓝色背景填充,字体颜色为白色Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)If Target.Row >= 2 Then’第二行以下的区域On Error Resume Next[ChangColor_With1].FormatConditions.Delete = "ChangColor_With1"With [ChangColor_With1].FormatConditions.Delete.Add xlExpression, , "TRUE".Item(1).Interior.ColorIndex = 5.Item(1).Font.ColorIndex = 2End WithEnd IfEnd Sub8.使窗体在启动的时候自动最大化Private Sub UserForm_Initialize()Application.WindowState = xlMaximizedWith ApplicationMe.Top = .TopMe.Left = .LeftMe.Height = .HeightMe.Width = .WidthEnd WithEnd Sub9.不保存工作簿退出EXCELApplication.DisplayAlerts = FalseApplication.Quit10.使窗体的关闭按纽不好用Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)If CloseMode = vbformcontrdmenu ThenMsgBox "请用关闭按钮关闭窗口!!", 64, "提示"Cancel = TrueEnd IfEnd Sub11.使窗体在3秒后自动关闭Private Sub UserForm_Activate()Application.Wait Now + TimeValue("00:00:03")UserForm1.HideEnd Sub12.启动窗体的时候自动使Label1显示Sheet1工作表3列,8行的内容Private Sub UserForm_Activate()Label1.Caption = Sheets("sheet1").Cells(3, 8)End Sub13.让按纽CommandButton1在窗体上以不可用状态显示CommandButton1.Enabled = False14.让按纽Commandbutton1在窗体上以隐藏方式存在CommandButton10.Visible = False15.点击Commandbutton1按纽进入”工资”工作表Sheets("工资").Select16.在Textbox1中输入数据,窗体可显示出”工资”工作表中与输入内容关联的项Private Sub TextBox1_Change()For X = 1 To Application.CountA(Sheets("工资").Range("a:a")) If Sheets("工资").Cells(X, 1) = TextBox1.Text Then’在工资表第一列查找与Textbox1输入相符的项Label2.Caption = Sheets("工资").Cells(X, 2)’在Label2中显示Textbox1数据所在的第二列的数据Label7.Caption = Sheets("工资").Cells(X, 3)’在Label2中显示Textbox1数据所在的第三列的数据End IfNextEnd Sub17.使EXCEL启动的时候自动最小化/最大化Private Sub Workbook_Open()Application.WindowState = xlMinimized’最小化Application.WindowState = xlMaximized’最大化End Sub18.在Label25以数字的形式显示TextBox12×Label14的结果Label25.Caption = Val(TextBox12.Text) * Val(Label14.Caption)19.单选按纽名与Sheet6工作表名相同OptionButton6.Caption = 20.”登陆”窗体的显示,隐藏登陆.Show’显示登陆.Hide’隐藏21.使窗体的标题栏不显示(1)插入类模块” CFormChanger”代码如下:Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPrivate Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As LongPrivate Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As LongPrivate Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As LongPrivate Const GWL_STYLE As Long = (-16)Private Const WS_CAPTION As Long = &HC00000Dim hWndForm As Long……………………………………………………………………………………………………………..Public Property Set Form(oForm As Object) '29If Val(Application.Version) < 9 ThenhWndForm = FindWindow("ThunderXFrame", oForm.Caption)ElsehWndForm = FindWindow("ThunderDFrame", oForm.Caption)End IfSetFormStyleEnd Property……………………………………………………………………………………………………………….Private Sub SetFormStyle()Dim iStyle As Long, hMenu As Long, hID As Long, iItems As IntegeriStyle = GetWindowLong(hWndForm, GWL_STYLE)iStyle = iStyle And Not WS_CAPTIONiStyle = iStyle Or WS_THICKFRAMESetWindowLong hWndForm, GWL_STYLE, iStyleDrawMenuBar hWndFormEnd Sub(2)在所在窗体代码里声明Dim oFormChanger As New CFormChanger(3).在窗体的Activate事件中插入代码Set oFormChanger.Form = MeMe.SpecialEffect = fmspecia1EffectRaised以上三步每一步都不可缺少,否则不能完成.22.单击某单元格,该单元格所在的行与列都以蓝色背景填充Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)If Target.Row >= 2 Then’第二行以下的所有列On Error Resume Next[ChangColor_With2].FormatConditions.Delete[ChangColor_With3].FormatConditions.Delete = "ChangColor_With2" = "ChangColor_With3"With [ChangColor_With2].FormatConditions.Delete.Add xlExpression, , "TRUE".Item(1).Interior.ColorIndex = 5End WithWith [ChangColor_With3].FormatConditions.Delete.Add xlExpression, , "TRUE".Item(1).Interior.ColorIndex = 5End WithEnd IfEnd Sub23.显示动态时间（1）插入窗体Userform1及Label1并在窗体声明中插入Option ExplicitPublic nextRun As Date（2）在窗体Activate事件中插入Showtime（3）在窗体QueryClose事件中插入Application.OnTime nextRun, "showtime", schedule:=False （4）插入模块Module1并输入Option ExplicitSub showtime()bel1 = NowUserForm1.RepaintDoEventsUserForm1.nextRun = Now + 1 / 86400Application.OnTime UserForm1.nextRun, "showtime" End Sub24.加载Combobox1选项ComboBox1.AddItem "收入型"ComboBox1.Additem “支出型”25.使Textbox1自动程输入状态显示(有光标闪动)TextBox1.SetFocus26.打开C盘目录Shell "explorer.exe C:\", 1。

VBA编程中的常用代码VBA（Visual Basic for Applications）是一种编程语言，用于在Microsoft Office应用程序中编写自定义宏和功能。

以下是一些在VBA 编程中常常用到的代码片段和技巧。

1. Excel VBA：打开和关闭工作簿这段代码演示了如何在Excel VBA中打开和关闭一个工作簿。

```vbaSub OpenAndCloseWorkbookDim wb As WorkbookSet wb = Workbooks.Open("C:\Path\To\Your\File.xlsx")'在这里执行你的代码wb.Close SaveChanges:=FalseEnd Sub```2. Excel VBA：遍历工作表下面的代码展示了如何遍历一个Excel工作簿中的所有工作表。

```vbaSub LoopThroughWorksheetsDim ws As WorksheetFor Each ws In ThisWorkbook.Worksheets'在这里执行你的代码Next wsEnd Sub```3. Excel VBA：在工作表中查找特定值以下代码展示了如何在一个工作表中查找特定值并返回它的位置。

```vbaFunction FindValue(ByRef rng As Range, ByVal searchValue As String) As RangeDim cell As RangeSet FindValue = NothingFor Each cell In rngIf cell.Value = searchValue ThenSet FindValue = cellExit FunctionEnd IfNext cellEnd Function```4. Word VBA：插入文本以下代码演示了如何在Word文档中插入文本。

常用的VBA短句（带注释）[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 & "种。