excel常用宏集合

1、1：打开所有隐藏工作表2：循环宏3：录制宏时调用“停止录制”工具栏4：高级筛选5列不重复数据至指定表5：双击单元执行宏(工作表代码6：双击指定区域单元执行宏(工作表代码7：进入单元执行宏(工作表代码8：进入指定区域单元执行宏(工作表代码9：在多个宏中依次循环执行一个（控件按钮代码）10：在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）11：在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）12：根据A1单元文本隐藏/显示按钮（控件按钮代码）13：当前单元返回按钮名称（控件按钮代码）14：当前单元内容返回到按钮名称（控件按钮代码）15：奇偶页分别打印16：自动打印多工作表第

2、一页17：查找A列文本循环插入分页符18：将A列最后数据行以上的所有B列图片大小调整为所在单元大小19：返回光标所在行数20：在A1返回当前选中单元格数量21：返回当前工作簿中工作表数量22：返回光标选择区域的行数和列数23：工作表中包含数据的最大行数24：返回A列数据的最大行数25：将所选区域文本插入新建文本框26：批量插入地址批注27：批量插入统一批注28：以A1单元内容批量插入批注29：不连续区域插入当前文件名和表名及地址30：不连续区域录入当前单元地址31：连续区域录入当前单元地址32：返回当前单元地址33：不连续区域录入当前日期34：不连续区域录入当前数字日期35：不连续区域录入当前

3、日期和时间36：不连续区域录入对勾37：不连续区域录入当前文件名38：不连续区域添加文本39：不连续区域插入文本40：从指定位置向下同时录入多单元指定内容41：按aa工作表A列的内容排列工作表标签顺序42：以A1单元文本作表名插入工作表43：删除所有未选定工作表44：工作表标签排序45：定义指定工作表标签颜色46：在目录表建立本工作簿中各表链接目录47：建立工作表文本目录48：查另一文件的所有表名49：当前单元录入计算机名50：当前单元录入计算机用户名51：解除所有工作表保护52：为指定工作表加指定密码保护表53：在有密码的工作表执行代码54：执行前需要验证密码的宏(控件按钮代码55：执行前需

4、要验证密码的宏(56：拷贝A1公式和格式到A257：复制单元数值58：插入数值条件格式59：插入透明批注60：添加文本61：光标定位到指定工作表A列最后数据行下一单元62：定位选定单元格式相同的所有单元格63：按当前单元文本定位64：按固定文本定位65：删除包含固定文本单元的行或列66：定位数据及区域以上的空值67：右侧单元自动加5(工作表代码68：当前单元加269：A列等于A列减B列70：用于光标选定多区域跳转指定单元(工作表代码71：将A1单元录入的数据累加到B1单元（工作表代码）72：在指定颜色区域选择单元时添加/取消""（工作表代码）73：在指定区域选择单元时添加/

5、取消""（工作表代码）74：双击指定单元，循环录入文本（工作表代码）75：双击指定单元，循环录入文本（工作表代码）76：单元区域引用（工作表代码）77：在指定区域选择单元时数值加1（工作表代码）78：混合文本的编号79：指定区域单元双击数据累加（工作表代码）80：选择单元区域触发事件（工作表代码）81：当修改指定单元内容时自动执行宏（工作表代码）82：被指定单元内容限制执行宏83：双击单元隐藏该行（工作表代码）84：高亮显示行（工作表代码）85：高亮显示行和列（工作表代码）86：为指定工作表设置滚动范围（工作簿代码）87：在指定单元记录打印和预览次数（工作簿代码）88：自动

6、数字金额转大写（工作表代码）89：将所有工作表的A1单元作为单击按钮（工作簿代码）90：闹钟到指定时间执行宏（工作簿代码）91：改变Excel界面标题的宏（工作簿代码）92：在指定工作表的指定单元返回光标当前多选区地址（工作簿代码）93：B列录入数据时在A列返回记录时间（工作表代码）94：当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码）95：指定单元显示光标位置内容（工作表代码）96：每编辑一个单元保存文件97：指定允许编辑区域98：解除允许编辑区域限制99：删除指定行100：删除A列为指定内容的行1：打开所有隐藏工作表Sub 打开所有隐藏工作表(Dim i As Integ

7、erFor i = 1 To Sheets.CountSheets(i.Visible = TrueNext iEnd Sub2：循环宏Sub 循环(AAA = Range("C2"Dim i As LongDim times As Longtimes = AAA'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647For i = 1 To timesCall 过滤一行If Range("完成标志" = "完成" Then Exit For '假如名为'完成标志'

8、的命名单元的值等于'完成',则退出循环,假如一开始就等于'完成',则只执行一次循环就退出'If Sheets("传送参数".Range("A" & i.Text = "完成" Then Exit For '假如某列出现"完成"内容则退出循环Next iEnd Sub3：录制宏时调用“停止录制”工具栏Sub 录制宏时调用停止录制工具栏(Application.CommandBars("Stop Recording".Visible = Tru

9、eEnd 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:=Sh

10、eet2.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 BooleanIf Range("$A$1" = "关闭" Then E

11、xit SubSelect Case Target.AddressCase "$A$4"Call 宏1Cancel = TrueCase "$B$4"Call 宏2Cancel = TrueCase "$C$4"Call 宏3Cancel = TrueCase "$E$4"Call 宏4 Cancel = TrueEnd SelectEnd Sub6：双击指定区域单元执行宏(工作表代码Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Can

12、cel As BooleanIf 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&quo

13、t; = "关闭" Then Exit SubSelect Case Target.AddressCase "$A$5" '单元地址(Target.Address,或命名单元名字(Target.NameCall 宏1Case "$B$5"Call 宏2Case "$C$5"Call 宏3 End SelectEnd Sub8：进入指定区域单元执行宏(工作表代码Private Sub Worksheet_SelectionChange(ByVal Target As RangeIf Range("$

14、A$1" = "关闭" Then Exit SubIf Not Application.Intersect(Target, Range("A4:A9","C4:C9" Is Nothing Then Call 打开隐藏表End Sub9：在多个宏中依次循环执行一个（控件按钮代码）Private Sub CommandButton1_Click(Static RunMacro As IntegerSelect Case RunMacroCase 0宏1RunMacro = 1Case 1宏2RunMacro = 2Case 2

15、宏3RunMacro = 0End SelectEnd Sub10：在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Private Sub CommandButton1_Click(With CommandButton1If .Caption = "保护工作表" ThenCall 保护工作表.Caption = "取消工作表保护"Exit SubEnd IfIf .Caption = "取消工作表保护" ThenCall 取消工作表保护.Caption = "保护工作表"Exit SubEnd IfEn

16、d WithEnd Sub11：在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）Option ExplicitPrivate Sub CommandButton1_Click(With CommandButton1If .Caption = "宏1" ThenCall 宏1.Caption = "宏2"Exit SubEnd IfIf .Caption = "宏2" ThenCall 宏2.Caption = "宏3"Exit SubEnd IfIf .Caption = "宏3"

17、ThenCall 宏3.Caption = "宏1"Exit SubEnd IfEnd WithEnd Sub12：根据A1单元文本隐藏/显示按钮（控件按钮代码）Private Sub Worksheet_SelectionChange(ByVal Target As RangeIf Range("A1" > 2 ThenCommandButton1.Visible = 1ElseCommandButton1.Visible = 0End IfEnd SubPrivate Sub CommandButton1_Click(重排窗口End Sub13

18、：当前单元返回按钮名称（控件按钮代码）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 "现

19、在打印奇数页,按确定开始."For i = 1 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iMsgBox "现在打印偶数页,按确定开始."For i = 2 To Ps Step 2ActiveSheet.PrintOut from:=i, To:=iNext iEnd Sub16：自动打印多工作表第一页Sub 自动打印多工作表第一页(Dim sh As IntegerDim xDim yDim syDim syzx = InputBox("请输入起始工作表名字:"sy = Inpu

20、tBox("请输入结束工作表名字:"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 Long

21、'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647For i = 1 To timesCall 插入分页符Next iEnd SubSub 插入分页符(Cells.Find(What:="分页", After:=ActiveCell, LookIn:=xlValues, LookAt:= _xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _.ActivateEnd SubSub 取消原分页(Cells.SelectActive

22、Sheet.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 ThenEnd IfNextEnd Sub19：返回光标所在行数Sub 返

23、回光标所在行数(x = ActiveCell.RowRange("A1" = xEnd Sub20：在A1返回当前选中单元格数量Sub 在A1返回当前选中单元格数量(A1 = Selection.CountEnd Sub21：返回当前工作簿中工作表数量Sub 返回当前工作簿中工作表数量(MsgBox tEnd Sub22：返回光标选择区域的行数和列数Sub 返回光标选择区域的行数和列数(Range("A1" = xRange("A2" = yEnd Sub23：工作表中包含数据的最大行数Sub 包含数据的最大行数(n = Cells.

24、Find("*", , , , 1, 2.RowMsgBox nEnd Sub24：返回A列数据的最大行数Sub 返回A列数据的最大行数(n = Range("a65536".End(xlUp.RowRange("B1" = nEnd Sub25：将所选区域文本插入新建文本框Sub 将所选区域文本插入新建文本框(For Each rag In Selectionn = n & rag.Value & Chr(10NextWith Selection.Characters(Start:=1, Length:=3.Font

25、.Name = "黑体".FontStyle = "常规".Size = 12End WithEnd Sub26：批量插入地址批注Sub 批量插入地址批注(On Error Resume NextDim r As RangeFor Each r In Selectionr.AddCommentNextEnd IfEnd Sub27：批量插入统一批注Sub 批量插入统一批注(Dim r As Range, msg As Stringmsg = InputBox("请输入欲批量插入的批注", "提示", "随

26、便输点什么吧"For Each r In Selectionr.AddCommentNextEnd IfEnd Sub28：以A1单元内容批量插入批注Sub 以A1单元内容批量插入批注(Dim r As RangeFor Each r In Selectionr.AddCommentNextEnd IfEnd Sub29：不连续区域插入当前文件名和表名及地址Sub 批量插入当前文件名和表名及地址(For Each mycell In Selectionmycell.FormulaR1C1 = "" + ActiveWorkbook.Name + "&qu

27、ot; + ActiveSheet.Name + "!" + mycell.AddressNextEnd Sub30：不连续区域录入当前单元地址Sub 区域录入当前单元地址(For Each mycell In Selectionmycell.FormulaR1C1 = mycell.AddressNextEnd Sub31：连续区域录入当前单元地址Sub 连续区域录入当前单元地址(Selection = "=ADDRESS(ROW(,COLUMN(,4,1"Selection.CopySelection.PasteSpecial Paste:=xlPa

28、steValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=FalseEnd Sub32：返回当前单元地址Sub 返回当前单元地址(d = ActiveCell.AddressA1 = dEnd Sub33：不连续区域录入当前日期Sub 区域录入当前日期(Selection.FormulaR1C1 = Format(Now(, "yyyy-m-d"End Sub34：不连续区域录入当前数字日期Sub 区域录入当前数字日期(Selection.FormulaR1C1 = Format(Now(, "yy

29、yymmdd"End Sub35：不连续区域录入当前日期和时间Sub 区域录入当前日期和时间(Selection.FormulaR1C1 = Format(Now(, "yyyy-m-d h:mm:ss"End Sub36：不连续区域录入对勾Sub 批量录入对勾(Selection.FormulaR1C1 = ""End Sub37：不连续区域录入当前文件名Sub 批量录入当前文件名(Selection.FormulaR1C1 = ThisWorkbook.NameEnd Sub38：不连续区域添加文本Sub 批量添加文本(Dim s As R

30、angeFor Each s In Selections = s & "文本内容"NextEnd Sub39：不连续区域插入文本Sub 批量插入文本(Dim s As RangeFor Each s In Selections = "文本内容" & sNextEnd Sub40：从指定位置向下同时录入多单元指定内容Sub 从指定位置向下同时录入多单元指定内容(Dim arrarr = Array("1", "2", "13", "25", "46&q

31、uot;, "12", "0", "20"End Sub41：按aa工作表A列的内容排列工作表标签顺序Sub 按aa工作表A列的内容排列工作表标签顺序(Dim I%, str1$I = 1Sheets("aa".SelectDo While Cells(I, 1.Value <> ""str1 = Trim(Cells(I, 1.ValueSheets(str1.SelectSheets(str1.Move after:=Sheets(II = I + 1Sheets("a

32、a".SelectLoopEnd Sub42：以A1单元文本作表名插入工作表Sub 以A1单元文本作表名插入工作表(Dim nm As Stringnm = a1Sheets.AddActiveSheet.Name = nmEnd Sub43：删除所有未选定工作表Sub 删除所有未选定工作表(Dim sht As Worksheet, n As Integer, iFlag As BooleanDim ShtName( As StringReDim ShtName(1 To nn = 1For Each sht In ActiveWindow.SelectedSheetsShtNam

33、e(n = sht.Namen = n + 1NextApplication.DisplayAlerts = FalseFor Each sht In SheetsiFlag = FalseFor i = 1 To n - 1If ShtName(i = sht.Name TheniFlag = TrueExit ForEnd IfNextIf Not iFlag Then sht.DeleteNextApplication.DisplayAlerts = TrueEnd Sub44：工作表标签排序Sub 工作表标签排序(Dim i As Long, j As Long, nums As Lo

34、ng, 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(S

35、heets(j.Name < UCase(Sheets(i.Name ThenSheets(j.Move Before:=Sheets(iEnd 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(iEnd IfNext jNext iEnd IfEnd Sub259个常用宏-excelhome(22009-08-15 14:11:45

36、 45：定义指定工作表标签颜色Sub 定义指定工作表标签颜色(Sheets("Sheet1".Tab.ColorIndex = 46End Sub46：在目录表建立本工作簿中各表链接目录Sub 在目录表建立本工作簿中各表链接目录(Dim s%, Rng As RangeOn Error Resume NextSheets("目录".ActivateIf Err = 0 ThenSheets("目录".UsedRange.DeleteElseSheets.AddActiveSheet.Name = "目录"End I

37、fFor i = 1 To Sheets.CountIf Sheets(i.Name <> "目录" Thens = s + 1Set Rng = Sheets("目录".Cells(s - 1 Mod 20 + 1, (s - 1 20 + 1 + 1Rng = Format(s, " 0" & ". " & Sheets(i.NameEnd IfNextSheets("目录".Range("b:iv".EntireColumn.ColumnWi

38、dth = 20End Sub47：建立工作表文本目录Sub 建立工作表文本目录(Sheets.Add before:=Sheets(1Sheets(1.Name = "目录"For i = 2 To Sheets.CountCells(i - 1, 1 = Sheets(i.NameNextEnd Sub48：查另一文件的所有表名Sub 查另一文件的所有表名(On Error Resume NextDim i%Dim sh As WorksheetApplication.ScreenUpdating = FalseWorkbooks.Open Filename:=This

39、Workbook.Path & "2.xls"Windows("1.xls".Activate '当前文件名称Sheets("Sheet1".Select '当前表名称i = 1 '将表名称返回到第1行For Each sh In Workbooks("2.xls".WorksheetsCells(i, 1 = sh.Name '将表名称返回到第1列i = i + 1 '返回每个表名称向下移动1行Next shWindows("2.xls".Clo

40、se '关闭对象文件Application.ScreenUpdating = TrueEnd Sub49：当前单元录入计算机名Sub 当前单元录入计算机名(Selection = Environ("COMPUTERNAME"'Selection = Workbooks("临时表".Sheets("表2".Range("A1" 调用指定地址内容End Sub50：当前单元录入计算机用户名Sub 当前单元录入计算机用户名(Selection = Environ("Username"&

41、#39;Selection = Workbooks("临时表".Sheets("表2".Range("A1" 调用指定地址内容End Sub51：解除所有工作表保护Sub 解除所有工作表保护(Dim n As IntegerFor n = 1 To Sheets.CountSheets(n.UnprotectNext nEnd Sub52：为指定工作表加指定密码保护表Sub 为指定工作表加指定密码保护表(Sheet10.Protect Password:="123"End Sub53：在有密码的工作表执行代码Sub

42、 在有密码的工作表执行代码(Sheets("1".Unprotect Password:=123 '假定表名为“1”，密码为“123” 打开工作表Sheets("1".Protect Password:=123 '重新用密码保护工作表End Sub54：执行前需要验证密码的宏(控件按钮代码Private Sub CommandButton1_Click(If InputBox("请输入密码：" <> "123" Then '密码是123MsgBox "密码错误,按确定退

43、出!", 64, "提示"Exit SubEnd IfCells(1, 1 = 10End Sub55：执行前需要验证密码的宏(Sub 执行前需要验证密码的宏(If InputBox("请输入您的使用权限:", "系统提示" = 123 Then重排窗口 '要执行的宏代码或宏名称ElseMsgBox "对不起,您没有使用该宏的权限,按确定键后退出!"End IfEnd Sub56：拷贝A1公式和格式到A2Sub 拷贝A1公式到A2(Workbooks("临时表".Sheets(

44、"表1".Range("A1".CopyWorkbooks("临时表".Sheets("表2".Range("A2".PasteSpecialEnd Sub57：复制单元数值Sub 复制数值(s = Workbooks("book1".Sheets("Sheet1".Range("A1:A2"Workbooks("book2".Sheets("Sheet1".Range("A1:A2&q

45、uot; = sEnd Sub58：插入数值条件格式Sub 插入数值条件格式(Formula1:="70"Formula1:="55"Formula1:="60"End Sub59：插入透明批注Sub 插入透明批注(Selection.AddCommentDim XS As WorksheetActiveSheet.Comments(i.Text "透明批注"NextEnd Sub60：添加文本Sub 添加文本(Selection = Selection + "×" '不可在数

46、字后添加文本'Selection = Workbooks("临时表".Sheets("表2".Range("A1" 调用指定地址内容End Sub61：光标定位到指定工作表A列最后数据行下一单元Sub 光标定位到指定工作表A列最后数据行下一单元(a = Sheets("数据库".a65536.End(xlUp.RowSheets("数据库".SelectRange("A" & a + 1.SelectEnd Sub62：定位选定单元格式相同的所有单元格Sub

47、定位选定单元格式相同的所有单元格(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.Orientat

48、ion = Selection.Orientation.AddIndent = Selection.AddIndent.IndentLevel = Selection.IndentLevel.ShrinkToFit = Selection.ShrinkToFit.MergeCells = Selection.MergeCells.Locked = Selection.Locked.FormulaHidden = Selection.FormulaHiddenEnd With If FirstCell Is Nothing ThenExit SubEnd IfSet AllCells = Fir

49、stCellSet FoundCell = FirstCell DoIf FoundCell Is Nothing Then Exit DoSet AllCells = Union(FoundCell, AllCellsIf FoundCell.Address = FirstCell.Address Then Exit DoLoopAllCells.SelectEnd Sub63：按当前单元文本定位Sub 按当前单元文本定位(ABC = SelectionDim aa As RangeFor Each a In ActiveSheet.UsedRangeIf a Like ABC ThenIf

50、 aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.CellsEnd IfEnd IfNextaa.SelectEnd Sub64：按固定文本定位Sub 文本定位(Dim aa As RangeFor Each a In ActiveSheet.UsedRangeIf a Like "*合计*" ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.CellsEnd IfEnd IfNextaa.SelectEnd Sub65：删

51、除包含固定文本单元的行或列Sub 删除包含固定文本单元的行或列(DoCells.Find(what:="哈哈".ActivateLoop Until Cells.Find(what:="哈哈" Is NothingEnd Sub66：定位数据及区域以上的空值Sub 定位数据及区域以上的空值(Dim aa As RangeFor Each a In ActiveSheet.UsedRangeIf a Like 0 ThenIf aa Is Nothing ThenSet aa = a.CellsElseSet aa = Union(aa, a.CellsE

52、nd IfEnd IfNextaa.SelectEnd Sub67：右侧单元自动加5(工作表代码Private Sub Worksheet_Change(ByVal Target As RangeApplication.EnableEvents = FalseTarget.Offset(0, 1 = Target + 5Application.EnableEvents = TrueEnd Sub68：当前单元加2Sub 当前单元加2(Selection = Selection + 2'Selection = Workbooks("临时表".Sheets("

53、表2".Range("A1" 调用指定地址内容End Sub69：A列等于A列减B列Sub A列等于A列减B列(For i = 1 To 23Cells(i, 1 = Cells(i, 1 - Cells(i, 2NextEnd Sub70：用于光标选定多区域跳转指定单元(工作表代码Private Sub Worksheet_SelectionChange(ByVal T As Rangea = Array(b6:b7, e6, h6For i = 0 To 2If Not Application.Intersect(T, a(i Is Nothing Thena

54、1.Select: Exit ForEnd IfNextEnd Sub71：将A1单元录入的数据累加到B1单元（工作表代码）Private Sub Worksheet_Change(ByVal Target As RangeDim t As LongIf Target.Address = "$A$1" Thent = Sheet1.Range("$B$1".ValueSheet1.Range("$B$1".Value = t + Target.ValueEnd IfEnd Sub72：在指定颜色区域选择单元时添加/取消"&q

55、uot;（工作表代码）Private Sub Worksheet_SelectionChange(ByVal Target As RangeDim myrg As RangeFor Each myrg In TargetNextEnd Sub73：在指定区域选择单元时添加/取消""（工作表代码）Private Sub Worksheet_SelectionChange(ByVal Target As RangeDim Rng As RangeIf Target.Count <= 15 ThenIf Not Application.Intersect(Target, R

56、ange("D6:D20" Is Nothing ThenFor Each Rng In SelectionWith RngIf .Value = "" Then.Value = ""Else.Value = ""End IfEnd WithNextEnd IfEnd IfEnd Sub74：双击指定单元，循环录入文本（工作表代码）Private Sub Worksheet_BeforeDoubleClick(ByVal T As Range, Cancel As BooleanIf T.Address <&

57、gt; "$A$1" Then Exit SubCancel = TrueT = IIf(T = "好", "中", IIf(T = "中", "差", "好"End Sub75：双击指定单元，循环录入文本（工作表代码）Dim nums As BytePrivate Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As BooleanIf Target.Address = "$A$1&quo

58、t; Thennums = nums Mod 3 + 1Target = Mid("上中下", nums, 1Target.Offset(1, 0.SelectEnd IfEnd Sub76：单元区域引用（工作表代码）Private Sub Worksheet_Activate(Sheet1.Range("A1:B3".Value = Sheet2.Range("A1:B3".ValueEnd Sub77：在指定区域选择单元时数值加1（工作表代码）Private Sub Worksheet_SelectionChange(ByVal

59、Target As RangeIf Not Application.Intersect(a1:e10, Target Is Nothing ThenTarget = Val(Target + 1End IfEnd Sub259个常用宏-excelhome(32009-08-15 14:12:58 78：混合文本的编号Sub 混合文本的编号(Worksheets(1.Range("B2".Value = "北京" & (-(Mid(Worksheets(1.Range("B2", 3, 100 + 1End Sub79：指定区域

60、单元双击数据累加（工作表代码）Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As BooleanIf Not Application.Intersect(A1:Y100, Target Is Nothing Thenoldvalue = Val(Target.Valueinputvalue = InputBox("请输入数量,按ENTER键确认!", "数值累加器"Target.Value = oldvalue + inputvalueEnd IfEnd Sub

61、80：选择单元区域触发事件（工作表代码）Private Sub Worksheet_SelectionChange(ByVal Target As RangeIf Target.Address = "$A$1:$B$2" ThenMsgBox "你选择了$A$1:$B$2单元"End IfEnd Sub81：当修改指定单元内容时自动执行宏（工作表代码）Private Sub Worksheet_Change(ByVal Target As RangeIf Not Application.Intersect(Target, B3:B4 Is Nothing Then重排窗口End IfEnd Sub82：被指定单元内容限制执行宏Sub 被指定单元限制执行宏(If Range("$A$1" = "关闭" Then Exit Sub窗口End Sub83：双击单元隐藏该行（工作表代