Excel中最常用的300句VBA编程语句
excel 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句
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代码
经典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 退出复制/剪切模式后，在程序运行时所进行的复制或剪切操作不会在原单元格区域留下流动的虚框线。
Excel-vba宏代码-大全
宏文件集▲打开全部隐藏工作表返回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代码段汇集，附中文解说
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。
vba常用代码大全
前言我们平时在工作表单元格的公式中常常使用函数，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。
EXCEL常用VBA代码
删除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)以指定的引用为参照系，通过给定偏移量得到新的引用。
excel VBA常用的100条语法
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。
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
最近研究了一下vba编程，主要是针对excel的，现在为了学习，特别从网上搜集了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) Appli cation.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=xlM aximized ‘将当前工作簿最大化工作表(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.Hy perlinks.Delete ‘取消当前工作表所有超链接(30) ActiveSheet.PageSetup.Orientation=xlLandscape或ActiveSheet.PageSetup.Orientation=2 ‘将页面设置更改为横向(31) ActiveSheet.PageSetup.RightFooter=ActiveWorkbook.FullName ‘在页面设置的表尾中输入文件路径ActiveSheet.PageSetup.LeftFooter=Application.U serName ‘将用户名放置在活动工作表的页脚单元格/单元格区域(32) ActiveCell.CurrentRegion.Select或Range(ActiveCell.End(xlUp),ActiveCell.End(xlDown)).Select‘选择当前活动单元格所包含的范围，上下左右无空行(33) Cells.Select ‘选定当前工作表的所有单元格(34) Range(“A1”).ClearContents ‘清除活动工作表上单元格A1中的内容Selection.ClearCo ntents ‘清除选定区域内容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)或Ra nge(“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(Hype rlinkcell.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。