EXCELVBA常用代码实战大全共393页word资料

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单元格的字体为粗体、背景色为红色、边框为实线。

V B A常用代码-E X C E LEXCEL VBA常用代码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.使窗体的标题栏不显示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 Long Private 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 SubDim oFormChanger As New CFormChangerSet 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.显示动态时间Option ExplicitPublic nextRun As DateShowtimeApplication.OnTime nextRun, "showtime", schedule:=FalseOption 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:\", 127.。

1 删除内容重复的行Sub DeleteRow()' 删除内容重复的行Dim R As IntegerDim i As IntegerWith Sheet1R = .[a65536].End(xlUp).RowFor i = R To 1 Step -1If WorksheetFunction.CountIf(.Columns(1), .Cells(i, 1)) > 1 Then.Rows(i).DeleteEnd IfNextEnd WithEnd Sub2 自动监视单元格Private Sub Worksheet_Change(ByVal Target As Range)Dim j, k, col As Integerj = Range("QTYS").Column'Range(iCol).Columnk = Target.Rowend_col = Range("end_cols").Column '13 '在这里调整颜色终止的最后一列col = Range("sum").Column'Stopqty = Target.ValueWith TargetIf .Count = 1 And .Row > 13 And .Column > col ThenIf Cells(k, col).Value = Cells(k, j).Value Then 'IsNumeric(Cells(k, col)) And Application.EnableEvents = FalseWith Range(Cells(k, 2), Cells(k, end_col)).Interior.ColorIndex = 4 'green.Pattern = xlSolidEnd WithApplication.EnableEvents = TrueElseIf Cells(k, col).Value > 0 And Cells(k, col).Value < Cells(k, j) ThenApplication.EnableEvents = FalseWith Range(Cells(k, 2), Cells(k, end_col)).Interior.ColorIndex = 6 ' yellow.Pattern = xlSolid 'xlNoneEnd WithApplication.EnableEvents = TrueElseIf Cells(k, col).Value > Cells(k, j).Value ThenApplication.EnableEvents = FalseWith Range(Cells(k, 2), Cells(k, end_col)).Interior.ColorIndex = 15.Pattern = xlSolid 'xlNoneEnd WithApplication.EnableEvents = TrueMsgBox "Actual Qty:" & qty & " > Order: " & Cells(k, j).Value & " or Wrong ?"ElseIf Cells(k, col).Value = 0 Or Cells(k, col).Value = "" ThenApplication.EnableEvents = FalseWith Range(Cells(k, 2), Cells(k, end_col)).Interior'.ColorIndex = 15.Pattern = xlNoneEnd WithApplication.EnableEvents = TrueEnd IfEnd IfEnd WithEnd Sub。

Excel VBA常用代码总结1改变背景色Range("A1"). = xlNoneColorIndex一览改变文字颜色Range("A1"). = 1获取单元格Cells(1, 2)Range("H7")获取范围Range(Cells(2, 3), Cells(4, 5))Range("a1:c3")'用快捷记号引用单元格Worksheets("Sheet1").[A1:B5]选中某sheetSet NewSheet = Sheets("sheet1")选中或激活某单元格'“Range”对象的的Select方法可以选择一个或多个单元格，而Activate 方法可以指定某一个单元格为活动单元格。

'下面的代码首先选择A1:E10区域，同时激活D4单元格：Range("a1:e10").SelectRange("d4:e5").Activate'而对于下面的代码：Range("a1:e10").SelectRange("f11:g15").Activate'由于区域A1:E10和F11:G15没有公共区域，将最终选择F11:G15，并激活F11单元格。

获得文档的路径和文件名'路徑'名稱'路徑＋名稱'或将ActiveWorkbook换成thisworkbook隐藏文档= False禁止屏幕更新= False禁止显示提示和警告消息= False文件夹做成strPath = "C:\temp\"MkDir strPath状态栏文字表示= "计算中"双击单元格内容变换Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If >= 5And <= 8) ThenIf = "●"Then= ""Else= "●"End IfCancel = TrueEnd IfEnd Sub文件夹选择框方法1Set objShell = CreateObject("")Set objFolder = (0, "文件", 0, 0)If Not objFolder Is NothingThen path= & "\"end ifSet objFolder = NothingSet objShell = Nothing文件夹选择框方法2（推荐）Public Function ChooseFolder() As StringDim dlgOpen As FileDialogSet dlgOpen = (msoFileDialogFolderPicker)With dlgOpen.InitialFileName = & "\"If .Show = -1ThenChooseFolder = .SelectedItems(1)End IfEnd WithSet dlgOpen = NothingEnd Function'使用方法例：Dim path As Stringpath = ChooseFolder()If path <> ""ThenMsgBox"open folder"End If文件选择框方法Public Function ChooseOneFile(Optional TitleStr As String = "Please choose a file", Optional TypesDec As String = "*.*", Optional Exten As String = "*.*") As StringDim dlgOpen As FileDialogSet dlgOpen = (msoFileDialogFilePicker)With dlgOpen.Title = TitleStr.. TypesDec, Exten.AllowMultiSelect = False.InitialFileName =If .Show = -1Then' .AllowMultiSelect = True' For Each vrtSelectedItem In .SelectedItems' MsgBox "Path name: " & vrtSelectedItem' Next vrtSelectedItemChooseOneFile = .SelectedItems(1)End IfEnd WithSet dlgOpen = NothingEnd Function某列到关键字为止循环方法1(假设关键字是end)Set CurrentCell = Range("A1")Do While <> "end"……Set CurrentCell = (1, 0)Loop某列到关键字为止循环方法2(假设关键字是空字符串)i = StartRowDo While Cells(i, 1) <> ""……i = i + 1Loop"For Each...Next 循环(知道确切边界)For Each c In Worksheets("Sheet1").Range("A1:D10").Cells If Abs < Then = 0Next"For Each...Next 循环(不知道确切边界),在活动单元格周围的区域内循环For Each c In If Abs < Then = 0Next某列有数据的最末行的行数的取得(中间不能有空行)lonRow=1Do While Trim(Cells(lonRow, ２).Value) <> ""lonRow = lonRow + 1LooplonRow11 = lonRow11 - 1A列有数据的最末行的行数的取得另一种方法Range("Ａ65536").End(xlUp).Row将文字复制到剪贴板Dim MyData As DataObjectSet MyData = New DataObjectRange("H7").Value取得路径中的文件名Private Function GetFileName(ByVal s As String)Dim sname() As Stringsname = Split(s, "\")GetFileName = sname(UBound(sname))End Function取得路径中的路径名Private Function GetPathName(ByVal s As String)intFileNameStart = InStrRev(s, "\")GetPathName = Mid(s, 1, intFileNameStart)End Function由模板sheet拷贝做成一个新的sheet("template").Copy After:=Set doc_s == "newsheetname" & Format(Now, "yyyyMMddhhmmss")选中当列的最后一个有内容的单元格(中间不能有空行)'删除B3开始到B列最后一个有内容的单元格为止的所有内容Range("B3").SelectRange(Selection, (xlDown)).Select常量定义Private Const StartRow As Integer = 3判断sheet是否存在Private Function IsWorksheet(ByVal strSeetName As String) As Boolean On Error GoTo ErrHandleDim blnRet As BooleanblnRet = IsNull(Worksheets(strSeetName))IsWorksheet = TrueExit FunctionErrHandle:IsWorksheet = FalseEnd Function向单元格中写入公式Worksheets("Sheet1").Range("D6").Formula = "=SUM(D2:D5)"引用命名单元格区域Range("!MyRange")Range("[]Sheet1!Sales"选定命名的单元格区域Reference:="!MyRange"'或者worksheets("sheetname").range("rangename").select使用Dictionary'使用Dictionary需要添加参照Microsoft Scripting RuntimeDim dic As New Dictionary"Table", "Cards"'前面是 Key 后面是 Value"Serial", "serialno""Number", "surface"MsgBox ("Table") '由Key取得Value("Table") '判断某Key是否存在将EXCEL表格中的两列表格插入到一个Dictionary中'函数：在ws工作表中，从iStartRow行开始到没有数据为止，把iKeyCol 列和iKeyCol右一列插入到一个字典中，并返回字典。

目录一、引用 (2)二、Worksheet_Change事件： (2)三、相乘 (4)四、相减 (5)五、高级筛选 (5)六、双击事件 (7)七．单位汇总（sumif），单条件汇总 (9)八、多条件汇总（连接、sumif） (11)九、多条件汇总、ado (13)十、对账 (15)十一、sql筛选 (18)十二、sql连接、交叉汇总 (20)十三、select语句总结 (22)十四、报表(有层次) (23)一、引用相对引用B4绝对引用$B$4混合引用＄B4、B＄4F4进行引用切换,$在字母前面则锁定列，在数字前面则锁定行。

二、Worksheet_Change 事件：1.在单元格中C4=VLOOKUP（B4，简码表!＄B＄4：$C＄1000，2，FALSE)2。

Worksheet_Change事件代码：Private Sub Worksheet_Change（ByVal Target As Range）On error resume nextIf Target.Row > 3 And Target。

Column = 2 Theni = Target.RowCells(i， 3） = Application.WorksheetFunction.VLookup(Cells（i, 2), Sheets(”简码表”）.Range（"b4:c100"）, 2, False)End IfEnd Sub备查代码：Private Sub Worksheet_Change(ByVal Target As Range）On Error Resume NextIf Target。

Row > 3 And Target。

Column = 5 Theni = Target.RowCells(i, 6） = Application.WorksheetFunction。

VLookup(Cells（i， 5）， Sheets(”类款项")。

宏文件集▲打开全部隐藏工作表返回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 去除指定范围内的对象()。

VBA常用技巧目录VBA常用技巧---------------------------------------------------- 第1章Range（单元格）对象--------------------------------- 技巧1 ---------------------------------- 单元格的引用方法1-1 ---------------------------------- 使用Range属性1-2 ---------------------------------- 使用Cells属性1-3 ------------------------------------ 使用快捷记号1-4 --------------------------------- 使用Offset属性1-5 --------------------------------- 使用Resize属性1-6 ---------------------------------- 使用Union方法1-7 ------------------------------ 使用UsedRange属性1-8 -------------------------- 使用CurrentRegion属性技巧2 ------------------------------ 选定单元格区域的方法2-1 --------------------------------- 使用Select方法2-2 ------------------------------- 使用Activate方法2-3 ----------------------------------- 使用Goto方法技巧3 -------------- 获得指定行、列中的最后一个非空单元格技巧4 ---------------------------------------- 定位单元格技巧5 ---------------------------------------- 查找单元格5-1 ----------------------------------- 使用Find方法5-2 --------------------------------- 使用Like运算符技巧6 -------------------------------- 替换单元格内字符串技巧7 ------------------------------------ 复制单元格区域技巧8 ------------------------------ 仅复制数值到另一区域8-1 ---------------------------------- 使用选择性粘贴8-2 ---------------------------------- 直接赋值的方法技巧9 ---------------------------- 单元格自动进入编辑状态技巧10 ------------------------------- 禁用单元格拖放功能2技巧11 ----------------------------------- 单元格格式操作11-1 ----------------------------- 单元格字体格式设置11-2 ----------------------------- 设置单元格内部格式11-3 --------------------------- 为单元格区域添加边框11-4 ----------------------- 灵活设置单元格的行高列宽错误!未定义书签。

主要内容和特点《ExcelVBA编程入门范例》主要是以一些基础而简短的VBA实例来对ExcelV BA中的常用对象及其属性和方法进行讲解，包括应用程序对象、窗口、工作簿、工作表、单元格和单元格区域、图表、数据透视表、形状、控件、菜单和工具栏、帮助助手、格式化操作、文件操作、以及常用方法和函数及技巧等方面的应用示例。

这些例子都比较基础，很容易理解，因而，很容易调试并得以实现，让您通过具体的实例来熟悉ExcelVBA编程。

■分16章共14个专题，以具体实例来对大多数常用的ExcelVBA对象进行讲解；■ 一般而言，每个实例都很简短，用来说明使用VBA实现Excel某一功能的操作；■各章内容主要是实例，即VBA代码，配以简短的说明，有些例子可能配以必要的图片，以便于理解；■您可以对这些实例进行扩充或组合，以实现您想要的功能或更复杂的操作。

VBE编辑器及VBA代码输入和调试的基本知识在学习这些实例的过程中，最好自已动手将它们输入到VBE编辑器中调试运行，来查看它们的结果。

当然，您可以偷赖，将它们复制/粘贴到代码编辑窗口后，进行调试运行。

下面，对VBE编辑器界面进行介绍，并对VBA代码输入和调试的基本知识进行简单的讲解。

激活VBE编辑器一般可以使用以下三种方式来打开VBE编辑器：■使用工作表菜单工具一一宏一一Visual Basic编辑器”命令，如图00-01所示; ■在Visual Basic工具栏上，按“ VisualBasic编辑器”按钮，如图00-02所示; ■按Alt+F11组合键。

图00-01 :选择菜单工具——宏——Visual Basic编辑器”命令来打开VBE编辑器图00-02 :选择Visual Basic工具栏上的“VisualBasic编辑器”命令按钮来打开VBE编辑器此外，您也可以使用下面三种方式打开VBE编辑器：■在任一工作表标签上单击鼠标右键，在弹出的菜单中选择查看代码”，则可进入VBE编辑器访问该工作表的代码模块，如图00-03所示；■在工作簿窗口左上角的Excel图标上单击鼠标右键，在弹出的菜单中选择查看代码”，则可进入VBE编辑器访问活动工作簿的ThisWorkbook代码模块，如图00-04所示；■选择菜单工具一一宏一一宏”命令打开宏对话框，若该工作簿中有宏程序，则单击该对话框中的编辑”按钮即可进行VBE编辑器代码模块，如图00-05所示。

前言我们平时在工作表单元格的公式中常常使用函数，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编程中的常用代码用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！使用Dim语句Dim a as integer '声明A为整形变量Dim a '声明A为变体变量Dim a as string '声明A为字符串变量Dim a,b,c as currency '声明A,b,c为货币变量......声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String （只限变长字符串）、String * length（定长字符串）、Object、Variant、用户定义类型或对象类型。

强制声明变量Option Explicit说明：该语句必在任何过程之前出现在模块中。

--------------------------------------------------------------------------------声明常数，用来代替文字值。

Const' 常数的默认状态是 Private。

Const My = 456' 声明 Public 常数。

Public Const MyString = "HELP"' 声明 Private Integer 常数。

Private Const MyInt As Integer = 5' 在同一行里声明多个常数。

Const MyStr = "Hello", MyDouble As Double = 3.4567--------------------------------------------------------------------------------在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。

1：打开所有隐藏工作表Sub打开所有隐藏工作表()Dim i As IntegerFor i=1To 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=1To timesCall过滤一行If Range("完成标志")="完成"ThenExit For'假如名为'完成标志'的命名单元的值等于'完成',则退出循环,假如一开始就等于'完成',则只执行一次循环就退出'If Sheets("传送参数").Range("A"&i).Text="完成"ThenExit 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 RunMacroCase0宏1RunMacro=1Case1宏2RunMacro=2Case2宏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 Explicit Private 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")>2ThenCommandButton1.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=1To Ps Step2ActiveSheet.PrintOut from:=i,To:=iNext iMsgBox"现在打印偶数页,按确定开始."For i=2To Ps Step2ActiveSheet.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=1To 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 Sub93：B列录入数据时在A列返回记录时间（工作表代码）Public Sub Worksheet_Change(ByVal Target As Range)If Target.Column=2ThenTarget.Offset(,-1)=NowEnd IfEnd Sub94：当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码）Public Sub Worksheet_Change(ByVal Target As Range)If Not Application.Intersect(Target,[A1:A1000])Is Nothing Then If Target.Column=1ThenTarget.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 Then If Target.Column=1ThenTarget.Offset(,1)=Format(Now(),"yyyy-mm-dd")Target.Offset(,2)=Format(Now(),"h:mm:ss")End IfEnd IfEnd Sub95：指定单元显示光标位置内容（工作表代码）Private Sub Worksheet_SelectionChange(ByVal T As Range) Sheets(1).Range("A1")=SelectionEnd Sub96：每编辑一个单元保存文件Private Sub Worksheet_Change(ByVal Target As Range) ThisWorkbook.SaveEnd Sub97：指定允许编辑区域Sub指定允许编辑区域()ActiveSheet.ScrollArea="B8:G15"End Sub98：解除允许编辑区域限制Sub解除允许编辑区域限制()ActiveSheet.ScrollArea=""End Sub99：删除指定行Sub删除指定行()Workbooks("临时表").Sheets("表2").Range("5:5").Delete End Sub100：删除A列为指定内容的行Sub删除A列为指定内容的行()Dim a,b As Integera=Sheet1.[a65536].End(xlUp).RowFor b=a To2Step-1If Cells(b,1).Value="删除"ThenRows(b).DeleteEnd IfNextEnd SubExcel VBA常用代码总结1改变背景色Range("A1").Interior.ColorIndex = xlNone ColorIndex一览•改变文字颜色Range("A1").Font.ColorIndex = 1•获取单元格Cells(1, 2)Range("H7")•获取范围Range(Cells(2, 3), Cells(4, 5))Range("a1:c3")'用快捷记号引用单元格Worksheets("Sheet1").[A1:B5]•选中某sheetSet NewSheet = Sheets("sheet1")NewSheet.Select•选中或激活某单元格'“Range”对象的的Select方法可以选择一个或多个单元格，而Activate方法可以指定某一个单元格为活动单元格。

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

1.删除重复行 (1)2. ActiveX控件的相关操作 (1)3. 单元格内容匹配 (2)4。

单元格填充公式 (3)5。

弹出打开对话框 (3)6. 操作文件夹下的所有工作簿 (3)7. 获取数据区域的最后一行和最后一列 (4)8. 获取列的字母顺序[A~IV］ (4)9. 自定义函数返回数组并填充至单元格区域 (4)10. 绘制曲线图 (5)11. 单元格区域拷贝 (5)12. 操纵数据库(查、增、删、改） (6)13。

待定XX (6)1.删除重复行关键字：[a65536］.End（xlUp).Row、Offset（)、相关双层循环Sub RemoveDuplicate(）'删除重复行For i = [a65536].End(xlUp)。

Row — 1 To 1 Step —1 '按倒叙删除For j = [a65536]。

End(xlUp).Row To i + 1 Step —1If Cells(i， 1)。

Value = Cells（j， 1）.Value ThenRows（i)。

DeleteEnd IfNextNextEnd SubSub RemoveItem()'删除相邻重复，但不删除隔行重复Dim i As LongWith Range（"A2”）’以A2为基准进行单元格偏移Do While .Offset(i, 0)If .Offset（i， 0)。

Value = .Offset（i — 1, 0）。

Value Then 。

Offset（i, 0）.EntireRow.Delete i = i + 1LoopEnd WithEnd Sub2.ActiveX控件的相关操作关键字：ActiveX、OLEObjects、ActiveSheet。

OLEObjects遍历控件Dim c As ObjectFor Each c In ActiveSheet.OLEObjectsIf = ”ComboBox” & i Then’…………。

前言我们平时在工作表单元格的公式中常常使用函数，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编程的常用代码用过VB的人都应该知道如何声明变量，在VBA中声明变量和VB中是完全一样的！使用Dim语句Dim a as integer '声明a为整型变量Dim a '声明a为变体变量Dim a as string '声明a为字符串变量Dim a as currency ,b as currency ,c as currency '声明a,b,c为货币变量......声明变量可以是：Byte、Boolean、Integer、Long、Currency、Single、Double、Decimal（当前不支持）、Date、String（只限变长字符串）、String * length （定长字符串）、Object、Variant、用户定义类型或对象类型。

强制声明变量Option Explicit说明：该语句必在任何过程之前出现在模块中。

声明常数用来代替文字值。

Const' 常数的默认状态是 Private。

Const My = 456' 声明 Public 常数。

Public Const MyString = "HELP"' 声明 Private Integer 常数。

Private Const MyInt As Integer = 5' 在同一行里声明多个常数。

Const MyStr = "Hello", MyDouble As Double = 3.4567选择当前单元格所在区域在EXCEL97中，有一个十分好的功能，他就是把鼠标放置在一个有效数据单元格中，执行该段代码，你就可以将连在一起的一片数据全部选中。

只要将该段代码加入到你的模块中。

Sub My_SelectSelection.CurrentRegion.SelectEnd sub返回当前单元格中数据删除前后空格后的值sub my_trimmsgbox Trim(ActiveCell.Value)end sub单元格位移sub my_offsetActiveCell.Offset(0, 1).Select'当前单元格向左移动一格ActiveCell.Offset(0, -1).Select'当前单元格向右移动一格ActiveCell.Offset(1 , 0).Select'当前单元格向下移动一格ActiveCell.Offset(-1 , 0).Select'当前单元格向上移动一格end sub如果上述程序产生错误那是因为单元格不能移动，为了解除上述错误，我们可以往sub my_offset 之下加一段代码 on error resume next注意以下代码都不再添加sub “代码名称” 和end sub请自己添加!给当前单元格赋值ActiveCell.Value = "你好！！！"给指定单元格赋值例如：Ａ１单元格内容设为"ＨＥＬＬＯ"Range("a1").value="hello"又如：你现在的工作簿在sheet1上，你要往sheet2的Ａ１单元格中插入"ＨＥＬＬＯ"1.sheets("sheet2").selectrange("a1").value="hello"或2.Sheets("sheet1").Range("a1").Value = "hello"说明：1.sheet2被选中，然后在将“HELLO"赋到A1单元格中。

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。

Excel VBA编程的常用代码时间:2009-11-2721:18:01来源:本站作者:未知我要投稿我要收藏投稿指南具体的步骤是，代码从活动工作表上活动单元格周围的当前单元格区域中读取数据。

宏将这些数据存储在一个数组中，计算每一行和每一列中的单元格总数，然后将输出显示在工作表中。

数组的大小由当前区域中的单元格数量决定。

注意：此宏不会在工作表中添加任何公式，因此如果该范围内的单元格总数有变化，则必须重新运行宏。

使用以下示例之前，请执行以下步骤：1.打开一个新工作簿。

2.在“工具”菜单中，指向“宏”，然后单击“Visual Basic编辑器”（或者简单地按下ALT+F11组合键）。

在“Visual Basic编辑器”中的“插入”菜单中，单击“模块”。

将以下示例代码键入或粘贴到模块中：Sub TotalRowsAndColumns()'此宏假定您已从'要计算单元格总数的矩形区域内'选择了一个单元格或一组单元格。

行和列的单元格总数将出现在'当前区域下面的行和右侧的列中。

Dim r As IntegerDim c As IntegerDim i As IntegerDim j As IntegerDim myArray As Variant'将myArray声明为变量将使数组可以接收'一组单元格。

此时，数组将自动转换为'以下标myArray(1,1)开始的数组。

'指当前所选单元格周围的区域。

With Selection.CurrentRegionr=.Rows.Countc=.Columns.Count'重新计算总行数和总列数并将结果存储到数组中。

myArray=.Resize(r+1,c+1)'在下面的嵌套循环中，变量i跟踪'行号，变量j跟踪'列号。

j在可用列中每循环一次，'i就递增一，而j'则重新从一到c循环一次。