excel常用宏集合
原文转自网络
1：打开所有隐藏工作表
Sub 打开所有隐藏工作表()
Dim i As Integer
For i = 1 To Sheets.Count
Sheets(i).Visible = True
Next i
End Sub
2：循环宏
Sub 循环()
AAA = Range("C2")
Dim i As Long
Dim times As Long
times = AAA
'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)
For i = 1 To times
Call 过滤一行
If Range("完成标志") = "完成" Then
Exit For
'假如名为'完成标志'的命名单元的值等于'完成',则退出循环,假如一开始就等于'完成',则只执行一次循环就退出
'If Sheets("传送参数").Range("A"
& i).Text = "完成" Then Exit For
'假如某列出现"完成"内容则退出循环
Next i
End Sub
3：录制宏时调用“停止录制”工具栏
Sub 录制宏时调用停止录制工具栏()
Application.CommandBars("Stop Recording").Visible = True
End Sub
4：高级筛选5列不重复数据至指定表
Sub 高级筛选5列不重复数据至Sheet2()
Sheets("Sheet2").Range("A1:E65536") = "" '清除Sheet2的A:D列
Range("A1:E65536").AdvancedFilter Action:=xlFilterCopy,
CopyToRange:=Sheet2.Range( _
"A1"), Unique:=True
Sheet2.Columns("A:E").Sort Key1:=Sheet2.Range("A2"),
Order1:=xlAscending,
Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod
_
:=xlPinYin
End Sub
5：双击单元执行宏(工作表代码)
Private Sub
Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Range("$A$1") = "关闭" Then
Exit Sub
Select Case Target.Address
Case "$A$4"
Call 宏1
Cancel = True
Case "$B$4"
Call 宏2
Cancel = True
Case "$C$4"
Call 宏3
Cancel = True
Case "$E$4"
Call 宏4
Cancel = True
End Select
End Sub
6：双击指定区域单元执行宏(工作表代码)
Private Sub
Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Range("$A$1") = "关闭" Then Exit Sub
If Not Application.Intersect(Target, Range("A4:A9",
"C4:C9")) Is Nothing Then Call 打开隐藏表
End Sub
7：进入单元执行宏(工作表代码)
Private Sub Worksheet_SelectionChange(ByVal
Target As Range)
'以单元格进入代替按钮对象调用宏
If Range("$A$1") = "关闭" Then Exit Sub
Select Case Target.Address
Case "$A$5" '单元地址(Target.Address),或命名单元名字(Target.Name)
Call 宏1
Case "$B$5"
Call 宏2
Case "$C$5"
Call 宏3
End Select
End Sub
8：进入指定区域单元执行宏(工作表代码)
Private Sub Worksheet_SelectionChange(ByVal
Target As Range)
If Range("$A$1") = "关闭" Then Exit Sub
If Not Application.Intersect(Target,
Range("A4:A9","C4:C9")) Is Nothing Then Call 打开隐藏表
End Sub
9：在多个宏中依次循环执行一个（控件按钮代码）
Private Sub CommandButton1_Click()
Static RunMacro As Integer
Select Case RunMacro
Case 0
宏1
RunMacro = 1
Case 1
宏2
RunMacro = 2
Case 2
宏3
RunMacro = 0
End Select
End Sub
10：在两个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）
Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "保护工作表" Then
Call 保护工作表
.Caption = "取消工作表保护"
Exit Sub
End If
If .Caption = "取消工作表保护" Then
Call 取消工作表保护
.Caption = "保护工作表"
Exit Sub
End If
End With
End Sub
11：在三个宏中依次循环执行一个并相应修改按钮名称（控件按钮代码）
Option Explicit
Private Sub CommandButton1_Click()
With CommandButton1
If .Caption = "宏1" Then
Call 宏1
.Caption = "宏2"
Exit Sub
End If
If .Caption = "宏2" Then
Call 宏2
.Caption = "宏3"
Exit Sub
End If
If .Caption = "宏3" Then
Call 宏3
.Caption = "宏1"
Exit Sub
End If
End With
End Sub
12：根据A1单元文本隐藏/显示按钮（控件按钮代码）
Private Sub Worksheet_SelectionChange(ByVal
Target As Range)
If Range("A1") > 2 Then
CommandButton1.Visible = 1
Else
CommandButton1.Visible = 0
End If
End Sub
Private Sub CommandButton1_Click()
重排窗口
End Sub
13：当前单元返回按钮名称（控件按钮代码）
Private Sub CommandButton1_Click()
ActiveCell = CommandButton1.Caption
End Sub
14：当前单元内容返回到按钮名称（控件按钮代码）
Private Sub CommandButton1_Click()
CommandButton1.Caption = ActiveCell
End Sub
15：奇偶页分别打印
Sub 奇偶页分别打印()
Dim i%, Ps%
Ps =
ExecuteExcel4Macro("GET.DOCUMENT(50)") '总页数
MsgBox "现在打印奇数页,按确定开始."
For i = 1 To Ps Step 2
ActiveSheet.PrintOut from:=i, To:=i
Next i
MsgBox "现在打印偶数页,按确定开始."
For i = 2 To Ps Step 2
ActiveSheet.PrintOut from:=i, To:=i
Next i
End Sub
16：自动打印多工作表第一页
Sub 自动打印多工作表第一页()
Dim sh As Integer
Dim x
Dim y
Dim sy
Dim syz
x = InputBox("请输入起始工作表名字:")
sy = InputBox("请输入结束工作表名字:")
y = Sheets(x).Index
syz = Sheets(sy).Index
For sh = y To syz
Sheets(sh).Select
Sheets(sh).PrintOut from:=1, To:=1
Next sh
End Sub
17：查找A列文本循环插入分页符
Sub 循环插入分页符()
' Selection = Workbooks("临时表").Sheets("表2").Range("A1") 调用指定地址内容
Dim i As Long
Dim times As Long
times =
Application.WorksheetFunction.CountIf(Sheet1.Range("a:a"), "分页")
'times代表循环次数，执行前把times赋值即可(不可小于1，不可大于2147483647)
For i = 1 To times
Call 插入分页符
Next i
End Sub
Sub 插入分页符()
Cells.Find(What:="分页", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:=False) _
.Activate
ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
End Sub
Sub 取消原分页()
Cells.Select
ActiveSheet.ResetAllPageBreaks
End Sub
18：将A列最后数据行以上的所有B列图片大小调整为所在单元大小
Sub 将A列最后数据行以上的所有B列图片大小调整为所在单元大小()
Dim Pic As Picture, i&
i
= [A65536].End(xlUp).Row
For Each Pic In Sheet1.Pictures
If Not Application.Intersect(Pic.TopLeftCell, Range("B1:B"
& i)) Is Nothing Then
Pic.Top = Pic.TopLeftCell.Top
Pic.Left = Pic.TopLeftCell.Left
Pic.Height = Pic.TopLeftCell.Height
Pic.Width = Pic.TopLeftCell.Width
End If
Next
End Sub
19：返回光标所在行数
Sub 返回光标所在行数()
x
= ActiveCell.Row
Range("A1") = x
End Sub
20：在A1返回当前选中单元格数量
Sub 在A1返回当前选中单元格数量()
[A1] = Selection.Count
End Sub