1. 单步执行 ：F8
 2. 一次性执行：F5
 3. 退出：重置按钮
 4. 断点标记：F9
 5. 视图-工具栏-编辑
 

 
编写 VBA 的最终目的是在 Excel 中运行它，得到特定的结果。所以，写完一段 VBA 代码后，下一步骤就是运行它。
 
需要指出的是，本篇所指的「运行」指的是，在 Excel 界面中运行，而非在 VBA 编辑器中运行。
 
今天这篇文章就介绍如何在 Excel 里运行 VBA 的多种方法。不同的方法适用的情形不一样，可以根据特定需求，选择其中一种使用。
 
一般来说，运行 VBA 有以下 3 种方法：
 
从「开发工具」选项卡运行
 
通过给「形状」指定宏的方式运行
 
通过给「按钮」指定宏的方式运行
 
示例代码
 
为了演示运行 VBA 的多种方法，现准备了一个包含一个 VBA 宏的工作簿。包含的 VBA 宏是「编写你的第一个 VBA 宏」教程中编写的代码，具体如下：
 
Sub MyCode()
 
MsgBox "Hello World"
 
End Sub
 
此过程运行后弹出对话框，显示 “Hello World” 信息。
 
1 从「开发工具」选项卡运行
 
Excel 开发工具选项卡提供了一个查看工作簿包含的所有宏并且运行的功能。需要运行某一宏时，打开宏列表，选择想要运行的宏，点击「运行」即可。
 
具体步骤如下：
 
1)找到「宏」按钮。
 

 
2)点击宏按钮，会弹出工作簿包含的所有宏的列表。
 

 
3)选择想要的宏，点击右侧「执行」按钮，运行宏。
 

 
2 通过给「形状」指定宏的方式运行
 
Excel 中的形状，可以为其指定宏，当鼠标点击时，宏自动运行。优点是，可以给任何形状指定宏。
 

 
具体方法如下：
 
1)插入一个形状。
 

 
2)右键形状，选择「指定宏」。
 

 
3)在弹出的宏列表中，选择一个宏，后点击确定完成。
 

 
3 通过给「按钮」指定宏的方式运行
 
除了形状，Excel 提供一个内置的按钮，优点是可以自定义，并且有点击效果。
 

 
具体步骤如下：
 
1)找到开发工具→插入命令。
 

 
2)点击插入命令，从列表中选择「表单控件→按钮」。
 

 
3)点击按钮，这时出现一个宏列表。其中选择想要指定的宏，点击确定，完成指定宏。
 

 
总结
 
以上几个方法适合在当前工作簿运行自己包含的代码。针对个人宏工作簿和 Excel 插件，还有几个更为快捷的运行 VBA 的方法，这在以后的教程介绍。

 
文章目录
 
Office2013版
蓝色填充
合并居中换行
保存当前sheet
全域字体格式
色阶（绿）
热力图（红-蓝）
  
Office2019版
热力图（红-蓝）
 

 
Office2013版
 
蓝色填充
 
Sub FillBule()
' 快捷键: Ctrl+Shift+B
    With Selection.Interior 'interior：内部
        .ThemeColor = xlThemeColorAccent1 'accent：强调
        .TintAndShade = 0.8 'tint：色彩
    End With
End Sub
 
合并居中换行
 
Sub MergeCells()
' 快捷键: Ctrl+Shift+C
    Application.DisplayAlerts = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True 'wrap：缠绕
        .MergeCells = True 'merge：合并
    End With
    Application.DisplayAlerts = True
End Sub
 
保存当前sheet
 
修改bookname
 
Sub SaveSheet()
' 快捷键: Ctrl+Shift+S
'声明
    Dim newbook As Workbook, nowsheet As Worksheet, sheetname$, bookname$, ymd$
'赋值
    ymd = [Text(today(), "yyyymmdd")]
    sheetname = ActiveSheet.Name
    bookname = "C:\Users\yellow\Desktop\" & sheetname & ymd & ".xlsx"
    Set nowsheet = ActiveSheet
    Set newbook = Workbooks.Add
'警告关闭
    Application.DisplayAlerts = False
'复制
    nowsheet.Copy newbook.Sheets(1)
    newbook.SaveAs bookname
    newbook.Close
'警告恢复
    Application.DisplayAlerts = True
End Sub
 
全域字体格式
 
Sub 全域字体()
' 快捷键: Ctrl+Shift+Q
    Cells.Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With
    With Selection.Font
        .Name = "宋体"
        .Size = 9
    End With
End Sub
 
色阶（绿）
 
Sub GreenGradation()
' 快捷键: Ctrl+Shift+G
    Selection.FormatConditions.AddColorScale ColorScaleType:=2
'低位色
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 16776444
    End With
'高位色
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8109667
    End With
End Sub
 
热力图（红-蓝）
 
Sub Hot()
' 快捷键: Ctrl+Shift+H
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
'低位色
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 13011546
    End With
'中位色
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 16776444
    End With
'高位色
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
    End With
End Sub
 
 
Office2019版
 
热力图（红-蓝）
 
Sub Hot()
' 快捷键: Ctrl+Shift+H
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 13011546
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 16776444
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
End Sub

 
VBA常用代码模版
 
Tp0️⃣—零零散散小功能（持续更新）
Tp1️⃣—输出活动页面筛选后的行数
Tp2️⃣—创建数组存放数据
Tp2-1 静态数组
Tp2-2 动态数组
  
Tp3️⃣ 创建字典存放数据
Tp4️⃣ 优化代码运行速度
Tp5️⃣ 轻松实现工作簿加密
Tp6️⃣ 通过对话框选择文件-1
Tp7️⃣ 通过对话框选择文件-2
Tp8️⃣ 从目录页自动跳转至明细页
Tp9️⃣ 选择区域自动设置或取消值

 
Tp0️⃣—零零散散小功能（持续更新）
 
剪切列
替换字符
取消复制剪切状态
浮点数向上取值
区域添加边框
区域设置颜色
调整列宽、行高
待更新
 
'  小功能集合
Sub Demos()

	'	剪切一列到指定列
	With ThisWorkbook.Sheets(2)    
		.[AI:AI].Cut    
		.[AE:AE].Select    
		Selection.Insert Shift:=xlToRight
	End With

	'	替换字符，将（空白）替换为空
	With worksheet.[C:C]
		.Replace "(空白)", ""
	End With
	
	'	取消复制剪贴状态
	Application.CutCopyMode = False
	   
	'	将带有小数的数据向上取整
	NewData = Application.WorksheetFunction.RoundUp(Datas, 0)

	' 	单元格区域添加边框
	.Range("A4:N" & .Range("A9999").End(xlUp).Row).Borders.LineStyle = xlContinuous

	'  -------------单元格标色-------------
	'  指定区域标色
	With Range("C2:G9")
    	.Interior.ColorIndex = 0	' 无填充颜色
     	.Interior.ColorIndex = 3	' 红色
     	.Interior.ColorIndex = 5	' 蓝色              
    End With
    
	' 实现自动调整行高、列宽
	Rows("1:5").EntireRow.AutoFit			' 调整1至5行行高
    Columns("A:AA").EntireColumn.AutoFit    ' 调整A至AA列列宽
    ' 设置行高、列宽为固定值
    Rows("1:5").RowHeight = 15				' 设置1至5行行高为15
    Columns("A:AA").ColumnWidth = 15		' 设置A至AA列列宽为15

End Sub
 
 
 
颜色索引-Range属性
 
 
 
Tp1️⃣—输出活动页面筛选后的行数
 
' 获取活动页面筛选后的行数
Sub RowCntAfterFilter()

    Dim rngCell As Range
    Dim lngRowCnt As Long
    For Each rngCell In [a1].CurrentRegion.SpecialCells(xlCellTypeVisible).Areas
        lngRowCnt = lngRowCnt + rngCell.Rows.Count
    Next rngCell
	rows_count =  lngRowCnt - 1   '可视区行数
    MsgBox "筛选后数据行数为：" & rows_count 
    Set rngCell = Nothing
    
End Sub
 
Tp2️⃣—创建数组存放数据
 
 
 
通过数组可以快速对数据进行处理
 前提：表格数据须规范，不考虑合并单元格
 一维数组：数字(1,2,3,4)，字符串(a,b,c,d)
 二维数组：((1,1),(1,2),(1,3),(2,1),(2,2),(2,3)) 表格结构、行列转置、计算、遍历、统计…
 多维数组：不是很熟悉，不敢乱说（￣□￣｜｜）
 简单介绍静态数组、动态数组的使用
 
 
Tp2-1 静态数组
 
Sub SetArray()
	’   静态数组可直接通过 变量名=数组（）的方式设置
	array_number = Array(1,2,3,4,5)
	array_string = Array("张三","李四","王五","Sugar","Smile")
	
	'  可遍历，参数：count，Index 取值：data = array_data(1)
	'  赋值
	.[A1:A5] = array_number 
	.[B1:B5] = array_string

	'存放单元格区域数据到数组（二维数组的快捷应用）
	Dim arr As Variant       '定义一个Variant类型的变量，名称为arr
   	arr = Range("A1:C3").Value '将A1:C3中保存的数据存储到数组arr里
   	Range("E1:G3").Value = arr '将数组ar写入E1:G3单元格区域

End Sub
 
Tp2-2 动态数组
 
Sub VimArray()

	'自定义动态数组长度n，上界为0
	Dim n As Integer
	n = 0

	Dim SupArr() As String	 ' 定义动态数组存放供应商名称
	With ActiveSheet   
    	For i = 2 To .[A1048576].End(xlUp).Row
        	ReDim Preserve SupArr(n)		 '  给动态数组重定义一个实际的大小
        	n = n + 1
        	SupArr(n - 1) = .Cells(i, 3).Value  ' 存到动态数组里去
    	Next i
	End With

End Sub
 
Tp3️⃣ 创建字典存放数据
 
 
 
通过字典可以快速对数据进行处理
 存放键值对关系，key具有唯一性，
 参数：count，keys，values，Item
 需要创建字典对象后使用
 
 
'与Excel单元格结合，创建字典存放数据
Sub RngDict()

	Dim DicManForm As Object
	Set DicManForm = CreateObject("Scripting.Dictionary")
	key_MaxRow = ActiveSheet.[A66666].End(xlUp).Row	'活动工作表A列的最后一行的行数
	
    '对A列进行遍历
    For key_Row = 2 To key_MaxRow
    	'取A列不重复的值作为字典的key，索引值唯一
    	KeyXX = ActiveSheet.Cells(key_Row, 1).Value
     	'导入条件：不为空，不重复
     	If KeyXX <> "" And DicManForm.Exists(KeyXX) = False Then
            DicManForm.Add KeyXX, key_Row
      	End If
    Next
    '通过key值，重设对应的value，key不存在时会报错
    DicManForm(key) = value
	Set DicManForm = Nothing

End Sub
 
Tp4️⃣ 优化代码运行速度
 
 
 
为了加快代码的执行速度，最简单的方式，将代码的执行过程设置为不显示，可以在代码执行时，临时关闭后续设置：自动重算、自动刷新、弹窗警告
 温馨提示：以下代码需要成对出现，设置False后，末尾改回True
 
 
Sub AppSetting()

	’  程序开始
    With Application
        .ScreenUpdating = False		'  关闭屏幕刷新
        .EnableEvents = False		'  关闭事件触发
        .DisplayAlerts = False		'  关闭弹窗提示
    End With
    
    ' Your Code				'   调用程序运行的主体代码

	’程序末尾
    With Application
        .ScreenUpdating = True		'  恢复屏幕刷新
        .EnableEvents = True		'  恢复事件触发
        .DisplayAlerts = True		'  恢复弹窗提示
    End With
    
End Sub
 
好久不见、更新继续
 
Tp5️⃣ 轻松实现工作簿加密
 
Sub 解除全部工作表保护()
    Dim n As Integer
    For n = 1 To Sheets.Count
        Sheets(n).Unprotect
    Next n
End 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
 
Tp6️⃣ 通过对话框选择文件-1
 
' 设置选择文件的弹出窗口，自主选择文件
Sub FilePicker()
    
    Open_Path = ThisWorkbook.Sheets("操作界面").[B4]
    
    '新建一个对话框对象
    Set FileDialogObject = Application.FileDialog(msoFileDialogFilePicker)
    
    '配置对话框
    With FileDialogObject
        
        .Title = "请选择目标文件所在的文件夹："
        
        '添加判断，改变对话框默认打开的路径
        '默认打开上次的文件路径
        If Open_Path = "" Then
        .InitialFileName = "C:\"
        Else
        .InitialFileName = Open_Path
        End If
        
    End With
    
    '显示对话框
    FileDialogObject.Show
    '获取选择对话框选择的文件
    Set paths = FileDialogObject.SelectedItems
    
    With Sheets("操作界面")
        .[I:I].Clear
        file_ = paths.Item(1)       '包含绝对路径的文件名
        .[B4].Value = paths.Parent.InitialFileName      '当前文件所在目录
        .[B6].Value = Right(file_, Len(file_) - Len(paths.Parent.InitialFileName))  '获取文件
        
        '选择多个文件时，遍历所选文件，并写入I列
        If paths.Count > 1 Then
            i_Row = 2
            For Each Item In paths
                .Range("I" & i_Row) = Item
                i_Row = i_Row + 1
            Next
        End If
        
    End With
    
End Sub

 
Tp7️⃣ 通过对话框选择文件-2
 
'通过对话框选择文件路径
Sub FolderPicker()
    
    Open_Path = ThisWorkbook.Sheets("操作界面").[B4]
    
    '新建一个对话框对象
    Set FolderDialogObject = Application.FileDialog(msoFileDialogFolderPicker)
    
    '配置对话框
    '配置对话框
    With FolderDialogObject
        
        .Title = "请选择目标文件所在的文件夹："
        
        '添加判断，改变对话框默认打开的路径
        '默认打开上次的文件路径
        If Open_Path = "" Then
        .InitialFileName = "C:\"
        Else
        .InitialFileName = Open_Path
        End If
        
    End With
    
    FolderDialogObject.Show '显示对话框
    
    Set paths = FolderDialogObject.SelectedItems            '获取选择对话框选择的文件夹
    Set fso = CreateObject("Scripting.filesystemobject")    '取目标文件
    Set myf = fso.getfolder(paths.Item(1))                  '从指定路径下获取文件
    
    With Sheets("操作界面")
        .[I:I].Clear
        .[B4].Value = paths.Item(1)
        
        i_Row = 2
        For Each file In myf.Files
'            .Range("I" & i_Row) = file             '记录绝对路径+文件名
            .Range("I" & i_Row) = file.Name         '记录文件名
            i_Row = i_Row + 1
        Next
        
    End With
    
End Sub

 
Tp8️⃣ 从目录页自动跳转至明细页
 

 **小提示：**权限分配表中的合并单元格，其中有一个小技巧，请参考另一篇针对筛选单元格的笔记
 ------------如何解决筛选时只显示第一行------------
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Rng, oRng As Range      ' 定义变量Rng、oRng为单元格
    
    Set Rng = Range("B2:B18")   ' 设定Rng为可操作区域单元格
    Set oRng = Selection        ' 设定oRng为选中单元格
    
    '如果所选单元格在可操作区域外，退出本次运行
    If Application.Intersect(oRng, Rng) Is Nothing Then Exit Sub

    Application.ScreenUpdating = False

    ' 多选则退出，单选设置筛选值
    If Selection.Count > 1 Then Exit Sub Else AimValue = Selection.Value
    
    ' 自动跳转至目标工作表进行筛选
    With Sheets("权限分配表")

        If .FilterMode = True Then .ShowAllData
        .Range("A1").AutoFilter Field:=1, Criteria1:=AimValue, _
         Operator:=xlAnd
        .Activate
    
    End With
    
    Application.ScreenUpdating = True
    
End Sub

 
Tp9️⃣ 选择区域自动设置或取消值
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    On Error Resume Next

    Dim Rng, oRngs, oRng As Range     ' 定义变量Rng、oRng为单元格
    Dim Aim As String                 ' 定义变量Aim为字符串

    Aim = "√"                  ' 设定目标值
    
    Set Rng = Range("D2:H706")  ' 设定Rng为可操作区域单元格
    Set oRngs = Selection       ' 设定oRngs为选中单元格
    


    '如果所选单元格在可操作区域外，退出本次运行
    If Intersect(oRngs, Rng) Is Nothing Then Exit Sub

        
'    Selection.FormulaR1C1 = Aim      '直接设置所选区域内的值为"√"

    ' 针对选择区域，有值清空，空值设定Aim
    For Each oRng In oRngs
    
        If oRng.FormulaR1C1 = "" Then oRng.FormulaR1C1 = Aim Else oRng.FormulaR1C1 = ""

    Next
    
    On Error GoTo 0

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub


 
  未完待续、、、
  期待下次相遇