Excel Vba范例

第1部分 单元格选择技巧与选区统计

第1章 单元格与区域选择技巧

实例1选择A列最后一个非空单元格

Sub 选择A列最后一个非空单元格()
    Range("a1048576").End(xlUp).Select
End Sub

• 讲解
  • （1）Range()：返回一个Range对象，它代表一个单元格或单元格区域。区域的大小由其参数决定。
  • （2）Range(“a1048576”)：Excel 2003升级至2007后，可用行数从65536行提升至1048576行，所以表示A列最大行数时使用Range(“a1048576”).Row。
  • （3）End(xlUp)：Range.End属性返回一个Range对象，代表包含源区域的区域尾端的单元格。
  • （4）Range.Select：选择单元格。要选择单元格或单元格区域，使用Select方法。要使单个单元格成为活动单元格，请使用Activate方法。它们两者的区别是Select方法可选择多单元格，而Activate方法只能选择单个单元格。
• 补充
• （1）excel常用对象主要有四个
  • range:代表excel中的单元格或单元格区域
  • worksheet:代表excel中的工作表
  • workbook:代表excel中的工作簿
  • application:代表excel应用程序
• （2）记住excel2016有1048576行16384列，之前是65536行
• （3）Range对象的End属性有四个
  • xlToLeft：等同于在源单元格<按CTRL+左方向键>
  • xlToRight：等同于在源单元格<按CTRL+右方向键>
  • xlUp：等同于在源单元格<按CTRL+上方向键>
  • xlDown：等同于在源单元格<按CTRL+下方向键>
• （4） 选中单元格
  • Activate与Select方法不同

实例2基于指定位置的偏移量的选取

• 择当前单元格下一行已用区域外第一个空白单元格。

Private Sub Worksheet_Change(ByVal Target As Range)
    Cells(Target.Row + 1, 16384).End(xlToLeft).Offset(0, 1).Select
End Sub

• 讲解
  • （1）Sub Worksheet_Change(ByVal Target As Range)：工作表事件，在工作表中数据被修改时发生。需要特别指出的是，单元格中函数与公式结果改变时将不引发此事件。
  • （2）Cells()：单元格对象，等同于Range。Range()代表某一单元格、某一行、某一列、某一选定区域或者某一三维区域。而Cells()带参数时只能表示单个单元格，不带参数时表示工作表中所有单元格，不及range()表示单元格那么灵活。
  • （3）Cells(Target.Row+1, 16384)：Target是一个单元格对象，表示当前选中单元格区域；16384表示Excel 2016的最大列数；Cells(Target.Row+1, 16384)则表示相对于当前行的下一行最后一个单元格。
  • （4）Offset：表示指定单元格区域一定的偏移量位置上的区域，它有两个参数，一个为偏移行数，一个为偏移列数，可以是负数。

实例3选择当前列最大值

• 选择光标所在列的最大值所在的单元格，如果存在多个单元格等于最大值，仅选择第一个。

Sub 选择当前列最大值()
    Dim rng As Range, rng2 As Range '声明变量'
    Set rng2 = Application.Intersect(ActiveCell.EntireColumn, ActiveCell.CurrentRegion) '将本列已用区域赋值给rng2'
    For Each rng In rng2 '开始循环检测单元格值'
        If rng.Value = WorksheetFunction.Max(rng2) Then '如果等于最大值'
            rng.Select
            Exit For '退出循环'
        End If
    Next
End Sub

• 讲解
  • （1）Intersect：返回一个Range对象，该对象表示两个或多个区域重叠的矩形区域。
    本例中两个区域分别为ActiveCell.EntireColumn（表示当前列）和ActiveCell.CurrentRegion（表示当前单元格所在区域，当前区域是以空行与空列的组合为边界的区域），所以Intersect(ActiveCell.EntireColumn, ActiveCell.CurrentRegion)则表示当前列的已用区域，排除空白区。
  • （2）For Each…Next：这是一种循环语句，针对一个数组或集合中的每个元素，重复执行一组语句。
  • （3）WorksheetFunction.Max：VBA中没有直接求最大值的函数，但Excel工作表函数中有MAX可求最大值。
    在VBA中则可以通过WorksheetFunction前缀来调用工作表函数
  • （4）Dim：声明变量（变量：命名的存储位置与数据范围，包含在程序执行阶段可修改的数据。变量名在其声明范围内必须只有唯一名称不可重复。）并分配存储空间，每一个变量都需要声明方可使用。
    声明变量时除指定变量名称外，还会指定变量类型，不同类型占用空间不同，运行速度也不相同。当在过程中使用Dim语句时，通常将Dim语句放在过程的开始处。
  • （5）在过程中使用变量时一般需要先声明其名称和储存空间。
• 补充
• （1）excel中有常量和变量
• （2）常量
  • 声明：const 变量名称 as 数据类型 = 数值
  • 作用域：如果在过程中使用const语句声明的常量为本地常量，
  • 如果是在模块的第一个过程之前使用const语句声明的常量为模块级常量
• （3）变量分类与声明：
  • dim 变量名 as 数据类型
  • 公共变量：pubilc 变量名 as 数据类型
  • 私有变量：private 变量名 as 数据类型
  • 静态变量：static 变量名 as 数据类型
• 可以使用声明符声明变量
  • dim 变量名$

数据类型	类型声明字符
integer	%
long	&
single	!
double	#
currency	@
string	$

• （4）VBA的基本语句
  • If…Then语句
  • Select Case语句
  • For…Next语句
  • Do While语句
  • Do Until语句
  • For Each…Next语句
  • GoTo语句
  • With语句

自动选择最大值
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rng As Range, rng2 As Range '声明变量'
    Set rng2 = Application.Intersect(ActiveCell.EntireColumn, ActiveCell.CurrentRegion) '将本列已用区域赋值给rng2'
    For Each rng In rng2 '开始循环检测单元格值'
        If rng.Value = WorksheetFunction.Max(rng2) Then '如果等于最大值'
            rng.Select
            Exit For '退出循环'
        End If
    Next
End Sub

实例4选择负数单元格

Sub 选择负数单元格()
    Dim rg As Range, rng As Range
    For Each rng In Range("A1:B7")
        If rng < 0 Then
            If rg Is Nothing Then
                Set rg = rng
            Else
                Set rg = Application.Union(rg, rng)
            End If
        End If
    Next
    rg.Select
End Sub

• Application.Union：返回两个或多个区域的合并区域，支持30个参数

实例5选择单元格所在区域及工作表已用区域

Sub 选择已用区域()
    ActiveCell.CurrentRegion.Select
    MsgBox "已选择单元格所在区域。", 64, "提示"
    ActiveSheet.UsedRange.Select
    MsgBox "已选择本工作表所在区域。", 52, "提示"
End Sub

• （1）CurrentRegion：返回一个Range对象，该对象表示当前区域
• （2）ActiveSheet.UsedRange：返回一个Range对象，该对象表示指定工作表上所使用的区域，以使用区域的最大行、最大列为边界。
• （3）MsgBox：在对话框中显示消息，等待用户单击按钮，并返回一个Integer告诉用户单击哪一个按钮。MsgBox(prompt,buttons,title)

实例6选择数组公式区域

Sub 选择数组公式区域()
    ActiveCell.CurrentArray.Select
End Sub

• 讲解
  • ActiveCell.CurrentArray：表示当前单元格所在的数组区域。

实例7返回单元格合集与交集

Sub 单元格合集与交集()
    Application.union(range("A1:F8"),Range("H1:J8")).Select
    MsgBox "单元格合集",64,"提示"
    Application.Intersect([A1:F8],columns("E:E")).Select
    MsgBox "单元格交集",64,"提示"
end Sub 

• 讲解
  • （1）Application.Union：返回两个或多个区域的合并区域。
  • （2）Application.Intersect：该对象表示两个或多个区域重叠的矩形区域。
  • （3）[a1:f8]：这是range(“a1:f8”)的另一种写法，作用相同。

实例8选择背景色为黄色的单元格

Sub 选择黄色的单元格()
    Dim rng as range,rg as range 
    for each rng in activesheet.UsedRange
        if rng.interior.color = 65535 then 
            if rg is Nothing then 
                set rg = rng 
            else 
                set rg = application.union(rg,rng) 
            end if 
        end if 
    next 
    rg.select 
end Sub 

• 讲解
  • (range).Interior.Color：表示（单元格）内部颜色。也可以用RGB(0,0,0)形式表示

sub 单元格颜色()
    [a5].interior.color = RGB(255,0,0)
end sub 

实例9选择字体为蓝色之单元格

Sub 选择蓝色字体的单元格()
    Dim rng As Range, rg As Range
    For Each rng In ActiveSheet.UsedRange
    If rng.Font.ColorIndex = 5 Then
        If rg Is Nothing Then
            Set rg = rng
        Else
        Set rg = Application.Union(rg, rng)
        End If
    End If
    Next
    rg.Select
End Sub

• 讲解
  • 注意这里的excel字体颜色需要设置成#0000FF才行
  • (range).Font.ColorIndex：表示（单元格）字体颜色地址，可用1~56表示。可以用以下代码列出所有颜色地址对应的颜色
  • 可以用以下代码列出所有颜色地址对应的颜色：

Sub 颜色()
    Dim i As Byte
    For i = 1 To 56
        Cells(i, 1) = "colorindex" & i
        Cells(i, 2).Interior.ColorIndex = i
    Next
End Sub

实例10选择粗线边框之单元格

Sub 选择粗线边框的单元格()
   On Error Resume Next
    Dim rng As Range, rg As Range
    For Each rng In ActiveSheet.UsedRange
    If rng.Borders(xlEdgeRight).Weight = xlMedium And rng.Borders(xlEdgeTop).Weight = xlMedium _
    And rng.Borders(xlEdgeLeft).Weight = xlMedium And rng.Borders(xlEdgeBottom).Weight = xlMedium Then
        If rg Is Nothing Then
            Set rg = rng
        Else
        Set rg = Application.Union(rg, rng)
        End If
    End If
    Next
    rg.Select
End Sub

• 讲解
• （1）Borders.Weight：指定某一区域周围边框的宽度。Borders有一个参数表示方向，xlEdgeRight表示单元格的右边框；
  xlEdgeTop、xlEdgeBottom、xlEdgeLeft则分别表示上边框、下边框和左边框。
• （2）xlMedium：表示单元格边框的粗细，共有4种可选值，本例中为中等粗细。

名称	值	描述
xlhairline	1	细线（最细边框）
xlmediumline	-4138	中等
xlthick	4	粗线（最宽边框）
xlthin	2	细

• （3）On Error Resume Next：当程序错误时继续运行下句代码。
  本例中最后一步是选择带有粗线边框的单元格，假设在指定区域中不存在粗线边框的单元格，则程序运行到此句时要出错，加上“On Error Resume Next”则可以跳过错误。

实例11反向选择工作表

Sub 反向选择工作表()
    Application.DisplayAlerts = False  '禁用警告提示'
    Application.ScreenUpdating = False '禁止屏幕更新'
    Dim raddress As String, taddress As String '声明变量'
    raddress = Selection.Address
    taddress = ActiveSheet.UsedRange.Address
    With Sheets.Add '添加一个新工作表'
        .Range(taddress) = 0 '对新表赋值'
        .Range(raddress) = "=0" '对新表赋值'
        'raddress = .Range(taddress).SpecialCells(xlCellTypeConstants, 1).Address  重新设置address为含常量的单元格地址'
        .Delete
    End With
    ActiveSheet.Range(raddress).Select  '反向区域选择'
    Application.ScreenUpdating = True '开启屏幕更新'
End Sub

• 讲解
• （1）DisplayAlerts：如果宏运行时Microsoft Excel显示特定的警告和消息，则该属性值为True
• （2）ScreenUpdating：如果启用屏幕更新，则该属性值为True。
• （3）Sheets.Add：新建一个工作表。
• （4）Range.SpecialCells：返回一个Range对象，该对象代表与指定类型和值匹配的所有单元格。
  SpecialCells(Type,Value)

Type常量	值	说明
xlCellTypeAllFormatConditions	-4172	任意格式单元格
xlCellTypeAllValidation	-4174	含有验证条件的单元格
xlCellTypeBlanks	4	空单元格
xlCellTypeComments	-4144	含有注释的单元格
xlCellTypeConstants	2	含有常量的单元格
xlCellTypeFormulas	-4123	含有公式的单元格
xlCellTypeLastCell	11	已用区域中的最后一个单元格
xlCellTypeSameFormatConditions	-4173	含有相同格式的单元格
xlCellTypeSameValidation	-4175	含有相同验证条件的单元格
xlCellTypeVisible	12	所有可见单元格

Value常量	值	说明
xlErrors	16	错误值
xlLogical	4	逻辑值
xlNumbers	1	数字
xlTextValues	2	文本

实例12选择单元格区域但排除首行标题

sub 排除标题行()
    Application.Intersect(activesheet.UsedRange,activesheet.UsedRange.offset(1,0)).select 
end sub 

实例13每隔三行选一行

Sub 每隔三行选一行()
    Dim rng As Range, i As Long
    Application.ScreenUpdating = False '禁止屏幕更新'
    i = ActiveSheet.UsedRange.Rows.Count  '计算已用行数'
    With Range("XFD1:XFD" & i) '在最末列输入公式作为辅助列'
        .Formula = "=if(mod(row(),3),1,0/0)"  '行号除以3余数为1,2时显示1，否则显示一个0/0的错误值'
        Set rng = .SpecialCells(xlCellTypeFormulas, 16).EntireRow '参数16表示错误值'
        rng.Select '选择目标行'
        .Value = "" '清空输入区数据'
    End With
    Application.ScreenUpdating = True '开启屏幕更新'
End Sub

• 讲解
• （1）Range.Formula：即在单元格中输入公式，注意不要忘记等号
• （2）SpecialCells(xlCellTypeFormulas, 16)：表示包含错误值的所有单元格
• （3）EntireRow：表示整行，如[a3]. EntireRow表示第3行

实例14选择奇数列

Sub 选择奇数列()
    Dim rng As Range, rang As Range, i As Long
    Application.ScreenUpdating = False '禁止屏幕更新'
    i = ActiveSheet.UsedRange.Columns.Count  '计算已用列数'
    Set rang = ActiveSheet.UsedRange
    With Range(Range("A1048576"), Cells(1048576, i)) '在最末行输入公式作为辅助列'
        .Formula = "=if(mod(column(),2),0/0,1)"  '列号除以2余数为1时显示一个0/0的错误值,否则显示1'
        Set rng = .SpecialCells(xlCellTypeFormulas, 16).EntireColumn '参数16表示错误值'
        Application.Intersect(rng, rang, rang.Offset(1, 0)).Select '选择目标列与已用区域的交集'
        .Value = "" '清空输入区数据'
    End With
    Application.ScreenUpdating = True '开启屏幕更新'
End Sub

第2章 多表单元格选择

实例15同时选择三个表的B2∶B11区域

Sub 选择三个表的B2到B11区域()
    Sheets(Array("A组", "B组", "C组")).Select '组合工作表'
    Sheets("A组").Activate '激活第一个表'
    Range("B2:B" & [b1048576].End(xlUp).Row).Select '选择目标区域'
End Sub

• 讲解
• Array(arglist)：表示数组，参数arglist是一个用逗号隔开的列表，用于给数组赋值。

实例16选择本表以外所有工作表的B2∶B11区域

Sub 选择本表以外所有工作表的B2到B11区域()
    Dim sh As Worksheet, n%, i%, arr
    n = ThisWorkbook.Sheets.Count '取得工作表总数'
    ReDim arr(1 To n) '声明变量'
    For Each sh In ThisWorkbook.Sheets '循环检查工作表表名'
        If sh.Name <> ActiveSheet.Name Then
        i = i + 1
        arr(i) = sh.Name
        End If
    Next
    If i > 0 Then
        ReDim Preserve arr(1 To i)
        ThisWorkbook.Sheets(arr).Select '组合工作表'
        ActiveSheet.[B2:B11].Select '选择区域'
    End If
End Sub

• 讲解
• （1）ActiveSheet：代表活动工作簿中或指定的窗口或工作簿中的活动工作表（最上面的工作表）。如果没有活动的工作表，则返回Nothing。后缀.Name即取得工作表的名称。
• （2）ReDim：在过程级别中使用，用于为动态数组变量重新分配存储空间。

实例17选中名字包含“星期”的工作表的已用区域

Sub 多表选择()
    Dim wks As Worksheet, shtCnt  As Integer
    Dim arr() As Variant, i  As Integer
    shtCnt = ThisWorkbook.Sheets.Count '取得工作表总数'
    ReDim arr(1 To shtCnt) '声明变量'
    For Each wks In ThisWorkbook.Sheets '在所有工作表中循环'
        If wks.Name Like "星期*" Then
        i = i + 1
        arr(i) = wks.Name
        End If
    Next
    If i > 0 Then
        ReDim Preserve arr(1 To i)
        ThisWorkbook.Sheets(arr).Select '组合工作表'
        ActiveSheet.UsedRange.Select '选择区域'
    End If
End Sub

• 讲解
• 通配符包括“”和“？”，“”表示任意字符；“？”表示单个字符

第3章 对选区进行基本统计

实例18提取选区地址并计数

Sub 提取选区地址并计数()
    MsgBox "你选择了" & Selection.Address & Chr(10) & _
    "共有" & Selection.Count & "个"
End Sub

Sub 提取选区地址并计数()
    MsgBox "你选择了" & Selection.Address(RowAbsolute:=False,ColumnAbsolute:=False,ReferenceStyle:=xlR1C1) & Chr(10) & _
    "共有" & Selection.Count & "个"  
End Sub

• 讲解
• （1）Selection.Address：Selection表示选择的区域；Address表示地址，它有5个可选参数

名称	数据类型	描述
RowAbsolute	Variant	如果为True,则以绝对引用返回引用的行部分。默认值为True
ColumnAbsolute	Variant	如果为True， 则以绝对引用返回引用的列部分。默认值为True
ReferenceStyle	XIReferenceStyle	引用样式。默认值为xIAI
External	Variant	如果为True，则返回外部引用:如果为False, 则返回本地引用。默认值为False
如果RowAbsolute 和ColumnAbsolute 为False, 并且ReferenceStyle
RelativeTo	Variant	为xIR1Cl, 则必须包括相对引用的起始点。此参数是定义起始点的Range对象

• （2）Chr(10)：Chr()返回String，其中包含有与指定的字符代码相关的字符，0~31之间的数字与标准的非打印ASCII代码相同。正常范围为0-255。

实例19判断选区隐藏的单元格个数

Sub 判断选区隐藏的单元格个数()
    Dim cell as range,i%
    for each cell in selection 
        if cell.EntireRow.Hidden Or cell.EntireColumn.Hidden then 
            i = i+1  
        end if 
    next 
    MsgBox "隐藏单元格的个数为" & i
End Sub

• 讲解
• Range.Hidden：返回或设置一个Variant值，它指明是否隐藏行或列

实例20列出隐藏的单元格地址

Sub 判断单元格的隐藏状态()
    Dim cell As Range, temp As String
    On Error GoTo err
        For Each cell In Selection
            If cell.EntireRow.Hidden Or cell.EntireColumn.Hidden Then
                temp = temp & cell.Address & "、"
            End If
        Next
        temp = Left(temp, Len(temp)-1)
        MsgBox "以下单元格处于隐藏状态" & Chr(10) & temp: Exit Sub
err:
    MsgBox "没有处于隐藏状态的单元格"
End Sub

• 讲解

• （1）GoTo：无条件地转移到过程中指定的行，用于程序代码的转移。

• （2）On Error GoTo err：Error是程序错误，整句即表示当程序有错误时则运行标签“err”之后的代码。

• 补充

• 一开始不太理解temp=left(temp,len(temp)-1)这个代码的意思

• 应该是将temp删除最后一个"、“号后的语句，如果没有这句代码就会多个”、"

实例21统计空白单元格个数

Sub 空白单元格个数()
    MsgBox "空白单元格个数" & activesheet.UsedRange.SpecialCells(xlCellTypeBlanks).count 
End Sub

Sub 空白单元格个数()
    MsgBox "空白单元格个数" & Selection.SpecialCells(xlCellTypeBlanks).count 
End Sub

实例22统计公式个数

Sub 统计公式个数()
    MsgBox "统计公式个数" & activesheet.UsedRange.SpecialCells(xlCellTypeFormulas).count 
End Sub

Sub 统计公式个数()
    MsgBox "统计公式个数" & activesheet.UsedRange.SpecialCells(-4123).count 
End Sub

Sub 统计公式个数()
    activesheet.UsedRange.SpecialCells(-4123).select
    MsgBox "统计公式个数" & Selection.count 
End Sub

实例23计算已用行列数

Sub 计算已用行列数()
    dim rng as range,r%,c%
    set rng = activesheet.UsedRange 
    r = rng.Rows.count 
    c = rng.columns.count 
    MsgBox "已用行数" & r & "已用列数" & c,64,"提示"
End Sub

Sub 计算已用行列数()
    MsgBox "已用行数" & activesheet.UsedRange.Rows.count & "已用列数" & activesheet.UsedRange.columns.count
End Sub

实例24统计带批注之单元格个数

Sub 带批注之单元格个数()
    Dim i As Integer, cell As Range
    On Error GoTo err
    For Each cell In Selection
        If Not Intersect(cell, Cells.SpecialCells(xlCellTypeComments)) Is Nothing Then
            i = i + 1
        End If
    Next
    MsgBox "带批注之单元格个数" & i, 64, "提示"
    End
err:
    MsgBox "工作表中没有批注", 64
End Sub

• 讲解
• Cells.SpecialCells(xlCellTypeComments)：有批注的单元格。
• 如果工作表中没有批注，则程序要出错，故本例中使用了“On Error GoTo err”语句，当程序出错时，执行“err”标签处的语句。

实例25统计选区格式为“常规”之单元格个数

Sub 常规格式的单元格个数()
    dim i as integer,cell as range
    for each cell in selection
        if cell.numberformatlocal="G/通用格式" then 
        i = i + 1 
        end if 
    next 
    MsgBox "常规格式的单元格个数" & i 
end Sub

• 讲解
• G/通用格式：即为常规格式。
• 可以通过以下方法得到常规格式的名称：右键单击单元格后进入“设置单元格格式”对话框，单击“分类”下的“常规”，再单击“自定义”，
  则右边的“类型”框中将显示出“常规”格式的名称。

实例26分别统计选区中文本与字母、数字个数

Sub 统计选区中文本与字母数字个数()
    Dim te as Long,eng as Long,num as Long
    Dim i as Long,j as Long,cell as range,str as string
    if typename(selection) <> "Range" then MsgBox "请选择单元格！",64,"友情提示"：exit sub 
    for each cell in selection
        j = j+len(cell.value) '计算字符总长度'
        for i = 1 to len(cell)
            str = mid(cell.value,i,1)
            if str like "[一-龥]"=true then 
                te = te + 1
            elseif  str like "[a-zA-Z]"=true then 
                eng = eng + 1 
            elseif str like "[0-9]"=true then 
                num = num + 1 
            end if 
        next 
    next 
    MsgBox "所选单元格区域中共有字数" & j & Chr(10) & "汉字" & te _ 
    & "字母" & eng & "数字" & num 
end Sub

• 讲解
• （1）Like：用来比较两个字符串。"[一-龥]“表示从编码“一”到“龥”，即汉字之首尾编码，在此范围之内则是汉字；”[a-zA-Z]“表示小写和大写字母的编码范围；”[0-9]"表示数字编码范围。
• （2）TypeName：返回对象的类型。类型名称是区分大小写的

实例27统计选区中负数个数

Sub 统计选区中负数个数()
    Dim rng as range,i%
    for each rng in selection
        if rng.value < 0 then 
         i = i + 1
        end if 
    next 
    MsgBox "选区中负数个数" & i,64,"提示"
End Sub

• 讲解
• Integer：一种变量的数据类型，Integer变量存储为16位（2个字节）的数值形式，其范围为–32768到32767。
  Integer的类型声明字符是百分比符号（%）

第2部分 单元格数据处理技巧

第4章 选区数据转换

实例28将选区公式转换成数值

Sub 将选区公式转换成数值()
    Dim rng As Range
    Set rng = Application.InputBox("请选择公式单元格区域", "转换为数值", "a1", Type:=8) '选择区域'
    If rng Is Nothing Then Exit Sub '若点击取消则退出程序'
        rng = rng.Value '公式转为值'
End Sub

• 讲解
  （1）Application.InputBox函数：本例在输入单元格地址时可以用InputBox函数实现需求，也可以使用Application.InputBox函数。
  但InputBox只允许手工输入字符，且不带参数校验功能，即输入“ABC”等不规范的区域引用时不给予提示。本例引用区域时为了使用方便利用Application.InputBox函数的Type参数为8，不仅可以使用鼠标选择区域，还可以通过参数校验功能确保返回值是有效的单元格引用。
• Application.InputBox的Type参数

值	含义
0	公式
1	数字
2	文本（字符串）
4	逻辑值（True或False）
8	单元格引用，作为一个range对象
16	错误值，如N/A
64	数值数组

• 列出的Type参数中传递的值可以多个套用。
• 例如，对于一个可接受文本和数字的输入框，将Type设置为1+2；而返回逻辑值与数字则用1+4等
• （2）Exit Sub：此语句一般用于中途结束程序。
• 在本例中的作用是：如果在选择区域框中单击了“取消”按钮，则退出程序，如果不用“Exit Sub”，程序将中途弹出错误提示

Sub 将选区公式转换成数值()
    Dim rng As Range
    Set rng = Application.InputBox("请选择公式单元格区域", "转换为数值", "a1", Type:=8) '选择区域'
    If rng Is Nothing Then GoTo endd '若点击取消则退出程序'
        rng = rng.Value '公式转为值'
endd:
End Sub

实例29将当前区域公式转换成数值

Sub 将当前区域公式转换成数值()
    Dim rng As Range
    Set rng = ActiveSheet.UsedRange '选择区域'
    If rng Is Nothing Then Exit Sub '若点击取消则退出程序'
        rng = rng.Value '公式转为值'
End Sub

Sub 将当前区域公式转换成数值()
    ActiveCell.CurrentRegion.Copy '复制'
    ActiveCell.CurrentRegion.PasteSpecial Paste:=xlPasteValues  '粘贴数值'
End Sub

• 讲解
• （1）ActiveCell是指当前活动单元格，也是光标所在单元格。如果同时选择了一个区域，则ActiveCell是指选区左上角单元格
• （2）CurrentRegion表示当前已用区域，是以空行与空列的组合为边界的区域
• （3）PasteSpecial：将剪贴板中的Range对象粘贴到指定区域中。语法如下：
• expression.PasteSpecial(Paste,Operation,SkipBlabks,Transpose)
• Paste参数列表

值	描述
xIPasteAll	全部
xlPasteAllExceptBorders	边框除外
xlPasteColumnWidths	列宽
xIPasteComments	批注
xIPasteFormats	格式
xIPasteFormulas	公式
xIPasteFormulasAndNumberFormats	公式和数字格式
xlPasteValidation	有效性验证
xIPasteValues	值
xlPasteValuesAndNumberFormats	值和数字格式

实例30将数字转换为文本

Sub 将数字转换为文本()
    Selection.NumberFormatLocal = "@"
End Sub

• 讲解
• NumberFormatLocal：表示单元格数字格式，@符号即表示文本格式。

实例31自动将小写转换为大写

Private Sub Worksheet_Change(ByVal Target As Range)
    If IsEmpty(Target) Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    Application.EnableEvents = False
    Target.Value = UCase(Target.Value)
    Application.EnableEvents = True
End Sub

• 讲解
• （1）Worksheet_Change：工作表事件的一种。本例中表示当修改工作表中B列某单元格数据时执行相应的程序。
• （2）IsEmpty：返回Boolean值，指出变量是否已经初始化。本例中表示单元格为空时不执行后面的代码。
• （3）Exit Sub：表示退出程序
• （4）EnableEvents：指定是否启用事件。本例中修改小写字母为大写前禁用事件，否则将进入死循环，在修改完成后恢复
• （5）UCase：将小写字母转换为大写的函数。

实例32将英文转换为首字母大写

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Target = WorksheetFunction.Proper(Target.Text)
End Sub

• 讲解
• Proper：将英文单词首字母大写、其余字母小写的函数。因为是工作表函数，需要添加前缀“WorksheetFunction”。
• 如果不用工作表函数，也可以用以下VBA方式实现：

Private Sub Worksheet_Change(ByVal Target As Range)
    Target = StrConv(Target, vbProperCase)
End Sub

第5章 修改选区格式

实例33修改日期格式

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Column = 1 And Target.Count = 1 Then
        Target = Application.WorksheetFunction.Text(Target.Text, "yyyy""年""m""月""d""日""[$-804]aaaa")
    End If
End Sub

• 讲解
• Target.Column=1 And Target.Count=1：表示当前激活的单元格只有一个而且在第一列。其他列输入数据时忽略。

实例34将零值替换为空

Sub 将零值替换为空()
    Selection.Replace what:="0", replacement:="", lookat:=xlWhole
End Sub

• 讲解
• Replace(what,replacement,lookat,searchorder,matchcase,matchbyte,searchformat,repalceformat)
• 第一个参数表示替换的目标，第二个参数表示替换后的新值，第三个参数表示字符匹配方式。
• 本例表示查找值为“0”，替换值为空（符号""），必须完全匹配才替换。

实例35将区域数据改成以“万”为单位

Sub 将区域数据改成以万为单位()
    Selection.NumberFormatLocal="#"".""#,万"
End Sub

• 讲解
• NumberFormatLocal：单元格数字格式，可读/写。

实例36将“#”号以上标显示

Sub 标示上标()
    Dim FindStr As String, FirstAddress As String, tran As Range, i, j, k, l
    FindStr = "#" '标上上标的字符串'
    With Selection
        Set tran = .Find(FindStr, LookIn:=xlValues, lookat:=xlPart) '设定查找值'
        If Not tran Is Nothing Then '如果找到'
            FirstAddress = tran.Address '记录地址'
            Do
                i = (Len(tran.Value) - Len(WorksheetFunction.Substitute(tran.Value, FindStr, ""))) / Len(FindStr)
                k = 1
                For j = 1 To i
                    l = WorksheetFunction.Find(FindStr, tran.Value, k)
                    tran.Characters(Start:=l, Length:=Len(FindStr)).Font.Superscript = True '标示上标'
                    k = l + Len(FindStr)
                Next '查找下一个'
                Set tran = .FindNext(tran)
            Loop While Not tran Is Nothing And tran.Address <> FirstAddress '直到返回第一个地址'
        End If
    End With
End Sub

• 讲解
• （1）Len：返回字符串中字符的数目，或是存储一个变量所需的字节数。
• （2）For…Next：以指定次数来重复执行一组语句，达到循环检测目的。语法如下：for counter=Start to end [Step step]
• （3）Do…Loop：当条件为True时，或直到条件变为True时，重复执行一个语句块中的命令。语法如下：

Do [{while|until} condition]
[statements]
[Exit Do]
[statements]
loop 

或

Do 
[statements]
[Exit Do]
[statements]
loop [{while|until} condition]

实例37修改任意字符为上标

Sub 修改任意字符为上标()
    Dim r As Range, i%, First$, inputt
    inputt = InputBox("上表对象", "请输入加上标的对象", "#")
    Application.ScreenUpdating = False
    Set r = Cells.Find(inputt, lookat:=xlPart) 'xlpart表示单元格不同完全匹配'
    If Not r Is Nothing Then  '当找到时'
        First = r.Address '用First记录下第一个单元格的地址'
        Do
            For i = 1 To Len(r) '对找到的单元格，从第一个字符到最后一个字符'
            If Mid(r, i, 1) = inputt Then '假如是inputt指定字符时，则设置它为上标'
            r.Characters(Start:=i, Length:=1).Font.Superscript = True
            End If
        Next
        Set r = Cells.FindNext(r) '在找到的单元格之后，查找新一个单元格'
        Loop Until r.Address = First '重复过程,直到最后找到的单元格的地址等于第一个单元格的地址'
    End If
    Application.ScreenUpdating = True
End Sub

• 讲解
• InputBox：在一个对话框中显示提示，等待用户输入正文或单击按钮，并返回包含文本框内容的String。
• 语法如下（[]符号内的表示可选参数，其余的为必选参数）：
• InputBox(prompt[,title][,default][,xpos][,ypos][,helpfile,context])
• 其中，prompt表示显示在对话框中的字符串；title表示对话框标题；default表示输入字符的默认值；
• xpos和ypos表示对话框的XY坐标；最后两个参数指定帮助文件，一般不用。

实例38为任意字符添加下划线

Sub 任意字符添加下划线()
    Dim r As Range, i%, First$, inputt
    inputt = InputBox("下划线对象", "请输入加下划线的对象", "#")
    Application.ScreenUpdating = False
    Set r = Cells.Find(inputt, lookat:=xlPart) 'xlpart表示单元格不同完全匹配'
    If Not r Is Nothing Then  '当找到时'
        First = r.Address '用First记录下第一个单元格的地址'
        Do
            For i = 1 To Len(r) '对找到的单元格，从第一个字符到最后一个字符'
            If Mid(r, i, 1) = inputt Then '假如是inputt指定字符时，则加下划线'
            r.Characters(Start:=i, Length:=1).Font.Underline = xlUnderlineStyleSingle
            End If
        Next
        Set r = Cells.FindNext(r) '在找到的单元格之后，查找新一个单元格'
        Loop Until r.Address = First '重复过程,直到最后找到的单元格的地址等于第一个单元格的地址'
    End If
    Application.ScreenUpdating = True
End Sub

Sub 任意字符添加下划线()
    Dim r As Range, i%, First$, inputt,indexx
    inputt = InputBox("下划线对象", "请输入加下划线的对象", "#")
    set indexx = Application.InputBox("请输入欲加下划线的单元格区域，也可以用鼠标选择","定位","A1",,,,,8)
    Application.ScreenUpdating = False
    Set r = indexx.Find(inputt, lookat:=xlPart) 'xlpart表示单元格不同完全匹配'
    If Not r Is Nothing Then  '当找到时'
        First = r.Address '用First记录下第一个单元格的地址'
        Do
            For i = 1 To Len(r) '对找到的单元格，从第一个字符到最后一个字符'
            If Mid(r, i, 1) = inputt Then '假如是inputt指定字符时，则加下划线'
            r.Characters(Start:=i, Length:=1).Font.Underline = xlUnderlineStyleSingle
            End If
        Next
        Set r = indexx.FindNext(r) '在找到的单元格之后，查找新一个单元格'
        Loop Until r.Address = First '重复过程,直到最后找到的单元格的地址等于第一个单元格的地址'
    End If
    Application.ScreenUpdating = True
End Sub

• 讲解
• Underline：返回或设置应用于字体的下划线类型。

实例39在任意字符上方添加着重符

Sub 在任意字符上方添加着重符()
    Dim r As Range, i%, First$, inputt
    inputt = InputBox("输入欲加着重符的字符", "定位", "#", 50, 50)
    Application.ScreenUpdating = False
    Set r = Selection.Find(inputt, lookat:=xlPart) 'xlpart表示单元格不同完全匹配'
    If Not r Is Nothing Then  '当找到时'
        First = r.Address '用First记录下第一个单元格的地址'
        Do
            For i = 1 To Len(r) '对找到的单元格，从第一个字符到最后一个字符'
            If Mid(r, i, 1) = inputt Then '假如是inputt指定字符时，则加上着重符'
                r.Phonetics.Visible = True
                r.Characters(Start:=i, Length:=1).PhoneticCharacters = "."
                r.Phonetics.Font.Size = r.Font.Size + 2
                r.Phonetics.Font.Name = "黑体"
            Else
                r.Characters(Start:=i, Length:=1).PhoneticCharacters = ""
                r.Phonetics.Alignment = xlPhoneticAlignCenter
            End If
        Next
        Set r = Selection.FindNext(r) '在找到的单元格之后，查找新一个单元格'
        Loop Until r.Address = First '重复过程,直到最后找到的单元格的地址等于第一个单元格的地址'
    End If
    Application.ScreenUpdating = True
End Sub

• 讲解
• （1）PhoneticCharacters：返回或设置指定Characters对象中的拼音文本，可读/写。
• （2）xlPhoneticAlignCenter：表示拼音对齐方式为居中。

实例40数据重排

Sub 数据重排()
    Dim ans As Byte, anss As Byte, a(1 To 50) As Integer, i As Byte
    ans = InputBox("请选择：1升序,2降序", "选项", 1, 10, 10)
    anss = InputBox("请选择新数据产生在那一列" & Chr(10) & "只能输入数字", "选项", 2, 10, 10)
    For i = 1 To 50
        a(i) = ActiveSheet.Cells(i + 1, 1)
    Next
    Dim b(1 To 50)
    For i = 1 To 50
    If ans = 1 Then b(i) = Application.WorksheetFunction.Small(a, i)
    If ans = 2 Then b(i) = Application.WorksheetFunction.Large(a, i)
    Next
    For i = 1 To 50
    ActiveSheet.Cells(i + 1, anss) = b(i)
    Next
    ActiveSheet.Cells(1, anss) = "重排序"
End Sub

• 讲解
• （1）Small：工作表函数，需加前缀WorksheetFunction使用，返回第N小的值。
• （2）Large：工作表函数，返回第N大的值。