Sheet1.ScrollArea = \End Sub
在指定单元记录打印和预览次数（工作簿代码） Private Sub Workbook_BeforePrint(Cancel As Boolean) Range(\ End Sub
自动数字金额转大写（工作表代码）
Private Sub Worksheet_Change(ByVal M As Range) On Error Resume Next
y = Int(Round(100 * Abs(M)) / 100)
j = Round(100 * Abs(M) + 0.00001) - y * 100 f = (j / 10 - Int(j / 10)) * 10
A = IIf(y < 1, \元\
b = IIf(j > 9.5, Application.Text(Int(j / 10), \角\零\\
c = IIf(f < 1, \整\分\ M = IIf(Abs(M) < 0.005, \负\End Sub
将全部工作表的A1单元作为单击按钮（工作簿代码）
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = \ Call 宏名 End If End Sub
闹钟——到指定时间执行宏（工作簿代码） Private Sub Workbook_Open()
Application.OnTime (\提示1\ '宏名字 Application.OnTime (\提示2\ '宏名字 End Sub
改变Excel界面标题的宏（工作簿代码） Private Sub Workbook_Open() Application.Caption = \春节快乐\End Sub
在指定工作表的指定单元返回光标当前多选区地址（工作簿代码）
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Worksheets(\表2\End Sub
B列录入数据时在A列返回记录时间（工作表代码） Public Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 2 Then Target.Offset(, -1) = Now End If End Sub
当指定区域修改时在其右侧的2个单元返回当前日期和时间（工作表代码） Public Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, [A1:A1000]) Is Nothing Then If Target.Column = 1 Then Target.Offset(, 1) = Date Target.Offset(, 2) = Time End If End If End Sub
Public Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, [A1:A1000]) Is Nothing Then If Target.Column = 1 Then
Target.Offset(, 1) = Format(Now(), \ Target.Offset(, 2) = Format(Now(), \ End If End If End Sub
A列等于A列减B列
Sub A列等于A列减B列() For i = 1 To 23
Cells(i, 1) = Cells(i, 1) - Cells(i, 2) Next End Sub
用于光标选定多区域跳转指定单元(工作表代码)
Private Sub Worksheet_SelectionChange(ByVal T As Range) a = Array([b6:b7], [e6], [h6]) For i = 0 To 2
If Not Application.Intersect(T, a(i)) Is Nothing Then [a1].Select: Exit For End If Next End Sub
将A1单元录入的数据累加到B1单元（工作表代码） Private Sub Worksheet_Change(ByVal Target As Range) Dim t As Long
If Target.Address = \t = Sheet1.Range(\
Sheet1.Range(\End If End Sub
在指定颜色区域选择单元时添加/取消\（工作表代码） Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim myrg As Range For Each myrg In Target
If myrg.Interior.ColorIndex = 37 Then myrg = IIf(myrg <> \ Next End Sub
在指定区域选择单元时添加/取消\（工作表代码）
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Rng As Range
If Target.Count <= 15 Then
If Not Application.Intersect(Target, Range(\ For Each Rng In Selection With Rng
If .Value = \ .Value = \ Else
.Value = \ End If End With Next End If End If End Sub
双击指定单元，循环录入文本（工作表代码）
Private Sub Worksheet_BeforeDoubleClick(ByVal T As Range, Cancel As Boolean) If T.Address <> \$A$1\ Cancel = True
T = IIf(T = \好\中\中\差\好\ End Sub
双击指定单元，循环录入文本（工作表代码） Dim nums As Byte
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = \$A$1\ nums = nums Mod 3 + 1
Target = Mid(\上中下\ Target.Offset(1, 0).Select End If End Sub
单元区域引用（工作表代码） Private Sub Worksheet_Activate()
Sheet1.Range(\End Sub
在指定区域选择单元时数值加1（工作表代码）
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Application.Intersect([a1:e10], Target) Is Nothing Then Target = Val(Target) + 1 End If End Sub
混合文本的编号
Sub 混合文本的编号()
Worksheets(1).Range(\北京\End Sub
光标定位到指定工作表A列最后数据行下一单元
Sub 光标定位到指定工作表A列最后数据行下一单元() a = Sheets(\数据库\ Sheets(\数据库\ Range(\End Sub
定位选定单元格式相同的全部单元格
Sub 定位选定单元格式相同的全部单元格() Dim FirstCell As Range, FoundCell As Range Dim AllCells As Range
With 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.Name = Selection.Font.Name
.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.FormulaHidden End With
Set FirstCell = ActiveSheet.UsedRange.Find(what:=\ If FirstCell Is Nothing Then Exit Sub End If
Set AllCells = FirstCell Set FoundCell = FirstCell Do
Set FoundCell = ActiveSheet.UsedRange.Find(After:=FoundCell, what:=\searchformat:=True)
If FoundCell Is Nothing Then Exit Do Set AllCells = Union(FoundCell, AllCells)
If FoundCell.Address = FirstCell.Address Then Exit Do Loop AllCells.Select End Sub
按当前单元文本定位
Sub 按当前单元文本定位() ABC = Selection Dim aa As Range
For Each a In ActiveSheet.UsedRange If a Like ABC Then If aa Is Nothing Then Set aa = a.Cells Else
Set aa = Union(aa, a.Cells) End If End If Next aa.Select End Sub
按固定文本定位 Sub 文本定位() Dim aa As Range
For Each a In ActiveSheet.UsedRange If a Like \合计*\If aa Is Nothing Then Set aa = a.Cells Else
Set aa = Union(aa, a.Cells) End If End If Next aa.Select End Sub
删除包含固定文本单元的行或列
Sub 删除包含固定文本单元的行或列() Do
Cells.Find(what:=\哈哈\
Selection.EntireRow.Delete '删除行 ' Selection.EntireColumn.Delete '删除列
Loop Until Cells.Find(what:=\哈哈\End Sub
定位数据及区域以上的空值
Sub 定位数据及区域以上的空值() Dim aa As Range
For Each a In ActiveSheet.UsedRange If a Like 〈0 Then If aa Is Nothing Then Set aa = a.Cells Else
Set aa = Union(aa, a.Cells) End If End If Next aa.Select End Sub
右侧单元自动加5(工作表代码)
Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Target.Offset(0, 1) = Target + 5 Application.EnableEvents = True End Sub
当前单元加2
Sub 当前单元加2()
Selection = Selection + 2
'Selection = Workbooks(\临时表\表2\调用指定地址内容 End Sub
解除全部工作表保护
Sub 解除全部工作表保护() Dim n As Integer
For n = 1 To Sheets.Count Sheets(n).Unprotect Next n End Sub
为指定工作表加指定密码保护表
Sub 为指定工作表加指定密码保护表() Sheet10.Protect Password:=\End Sub
在有密码的工作表执行代码
Sub 在有密码的工作表执行代码()
Sheets(\假定表名为“1”，密码为“123” 打开工作表
Range(\ '隐藏C列空值行 Sheets(\ '重新用密码保护工作表 End Sub
执行前需要验证密码的宏(控件按钮代码) Private Sub CommandButton1_Click()
If InputBox(\请输入密码：\密码是123 MsgBox \密码错误,按确定退出!\提示\ Exit Sub End If
Cells(1, 1) = 10 End Sub
Sub 执行前需要验证密码的宏()
If InputBox(\请输入您的使用权限:\系统提示\ 重排窗口 '要执行的宏代码或宏名称 Else