excel常用宏集合

发表于2015-08-31
评论1 873浏览

想免费获取内部独家PPT资料库?观看行业大牛直播?点击加入腾讯游戏学院游戏策划行业精英群

361498939

 原文转自网络



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") = "" '清除Sheet2A: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

 

原文链接

著作权归作者所有,商业转载请联系作者获得授权,非商业转载请注明出处。

如社区发表内容存在侵权行为,您可以点击这里查看侵权投诉指引

游戏学院公众号二维码
腾讯游戏学院
微信公众号

提供更专业的游戏知识学习平台