第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)Intersect:返回一个Range对象,该对象表示两个或多个区域重叠的矩形区域。
- 补充
- (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大的值。