1.定位单元格
Excel中使用定位对话框(CTRL+G)可以选中工作表中特定的单元格区域,而在VBA中则使用Range.SpecialCells方法来实现类似的功能。
基本语法:
Range(“A1:D10”).SpecialCells(Type, Value)
参数说明:
type:指定要选择的单元格类型
Value:可选参数,用于进一步筛选单元格
常用的type参数值
- xlCellTypeConstants:常量(文本、数字等)
- xlCellTypeFormulas:公式
- xlCellTypeVisible:可见单元格
- xlCellTypeBlanks:空白单元格
- xlCellTypeLastCell:已使用区域的最后一个单元格
Sub test()
'选中A1:A10区域内的文本与数字单元格
Range("a1:a10").SpecialCells(xlCellTypeConstants).Select
End Sub
value参数用于进一步筛选符合特定条件的单元格,主要在定位公式和定位常量(文本和数字)时使用
value参数的可选值:
- xlTextValues:文本值
- xlNumbers:数值
- xlLogical:逻辑值(TRUE/FALSE)
- xlErrors:错误值(如 #N/A, #VALUE! 等)
Sub test()
'选中A1:A10区域内的数字单元格
Range("a1:a10").SpecialCells(xlCellTypeConstants, xlNumbers).Select
End Sub
2.查找单元格
Find方法
在VBA中可以使用Find方法查找特定内容的单元格
基本语法:
Range.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
参数说明:
- What: 要查找的内容(必须指定)
- After: 从哪个单元格开始查找(可选)
- LookIn: 查找的内容类型(xlValues, xlFormulas, xlComments)
- LookAt: 匹配整个单元格内容还是部分内容(xlWhole, xlPart)
- SearchOrder: 搜索顺序(xlByRows, xlByColumns)
- SearchDirection: 搜索方向(xlNext, xlPrevious)
- MatchCase: 是否区分大小写(True/False)
示例
Sub test()
Dim foundCell As Range
Set foundCell = ActiveSheet.Range("A1:D10").Find(What:="Apple", LookIn:=xlValues, lookat:=xlWhole)
'搜索时不会区分大小写
If Not foundCell Is Nothing Then
MsgBox "found" & foundCell.Address
Else
MsgBox "未找到结果"
End If
End Sub
补充:
搜索文本单元格时不会默认不会区分大小写
搜索文本单元格时,可以使用通配符
Find方法只能返回第一个匹配的单元格,如果有多个匹配项,它不会自动找到所有的匹配项
为了找到所有匹配项,我们需要结合使用Find和FindNext方法
Option Explicit
Sub RngFindNext()
' 声明变量
Dim StrFind As String ' 用于存储用户输入的查找字符串
Dim Rng As Range ' 用于存储查找结果的单元格范围
Dim FindAddress As String ' 用于存储第一个匹配单元格的地址
' 提示用户输入要查找的内容
StrFind = InputBox("请输入要查找的值")
' 检查用户是否输入了内容
If Trim(StrFind) <> "" Then
' 在Sheet1的A列中查找
With Sheet1.Range("A:A")
' 使用Find方法查找第一个匹配项
Set Rng = .Find(What:=StrFind, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
' 如果找到匹配项
If Not Rng Is Nothing Then
' 记录第一个匹配单元格的地址
FindAddress = Rng.Address
Do
' 将找到的单元格背景色设置为黄色(索引6)
Rng.Interior.ColorIndex = 6
' 查找下一个匹配项
Set Rng = .FindNext(Rng)
' 继续查找,直到再次找到第一个匹配项或找不到更多匹配项
Loop While Not Rng Is Nothing And Rng.Address <> FindAddress
End If
End With
End If
End Sub
FindPrevious方法和FindNext方法唯一的区别是:
前者查找匹配相同条件的前一个单元格,而后者是查找匹配相同条件的下一个单元格
Like运算符
使用Like运算符可以进行更为复杂的模式匹配查找,特别适用于需要模糊匹配或复杂匹配的场景
Like运算符的基本通配符:
*号 通配符:匹配任意数量的字符(包括0个字符)
?号 通配符:匹配任意单个字符
#号 通配符:匹配任意单个数字
[charlist]:匹配[charlist]中的任意单个字符
[!charlist]:匹配不在charlist中的任意单个字符
以下示例的功能:
提示用户输入一个搜索模式,并提供了简单的使用说明。
在整个已使用范围内搜索匹配该模式的单元格。
使用Like运算符进行模式匹配。
将所有匹配的单元格背景色设置为黄色。
统计并显示匹配项的数量。
Sub AdvancedFindWithLike()
Dim ws As Worksheet
Dim searchRange As Range
Dim cell As Range
Dim pattern As String
Dim matchCount As Long
' 设置工作表和搜索范围
Set ws = ActiveSheet
Set searchRange = ws.UsedRange
' 获取搜索模式
pattern = InputBox("请输入搜索模式:" & vbNewLine & _
"使用 * 匹配任意字符" & vbNewLine & _
"使用 ? 匹配单个字符" & vbNewLine & _
"使用 # 匹配单个数字" & vbNewLine & _
"例如: A*1#[AB]")
' 检查是否输入了模式
If pattern = "" Then Exit Sub
' 关闭屏幕更新以提高性能
Application.ScreenUpdating = False
' 初始化匹配计数
matchCount = 0
' 遍历搜索范围中的每个单元格
For Each cell In searchRange
' 使用Like运算符进行模式匹配
If cell.Value Like pattern Then
' 匹配成功,高亮显示单元格
cell.Interior.Color = vbYellow
matchCount = matchCount + 1
End If
Next cell
' 重新开启屏幕更新
Application.ScreenUpdating = True
' 显示结果
MsgBox "找到 " & matchCount & " 个匹配项。", vbInformation
End Sub
3.替换单元格内字符串
可以通过Range对象的Replace方法
基本语法:
Range.Replace(What, Replacement, [LookAt], [SearchOrder], [MatchCase], [MatchByte], [SearchFormat], [ReplaceFormat])
参数说明:
- What: 要查找的文本
- Replacement: 用于替换的文本
- LookAt: 可选,xlWhole(完全匹配)或 xlPart(部分匹配)
- SearchOrder: 可选,xlByRows(按行)或 xlByColumns(按列)
- MatchCase: 可选,是否区分大小写(True/False)
Sub ReplaceInCells()
Dim ws As Worksheet
Dim targetRange As Range
' 设置工作表和目标范围
Set ws = ThisWorkbook.Sheets("Sheet1")
Set targetRange = ws.Range("A1:D10")
' 基本替换
targetRange.Replace What:="old", Replacement:="new", LookAt:=xlPart
' 区分大小写的替换
targetRange.Replace What:="Excel", Replacement:="VBA", LookAt:=xlWhole, MatchCase:=True
' 使用通配符替换
targetRange.Replace What:="*data*", Replacement:="information", LookAt:=xlPart
' 替换特定格式的文本(例如,将所有红色文本改为蓝色)
With targetRange.Font
.Color = vbRed
.Name = "Arial"
End With
End Sub
4.复制单元格区域
要复制单元格区域到其他位置,使用Range对象的Copy方法
单元格的格式也会跟着一起复制过去
基本语法:
源区域.copy Destination:=目标区域
Sub 复制单元格区域()
' 复制A1:B5区域到D1:E5
Range("A1:B5").Copy Range("D1")
' 或者你也可以这样写:
' Range("A1:B5").Copy Destination:=Range("D1")
End Sub
Sub test()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("变更日志")
ws.Range("A1").Copy ws.Range("C1")
End Sub
PasteSpecial 选择性粘贴数据
主要用途为:
- 只粘贴特定内容
- 执行粘贴时的计算
- 转置数据
- 跳过空白单元格
粘贴特定内容:
只粘贴数值
只粘贴格式
只粘贴公式
只粘贴注释
执行粘贴时的计算
粘贴时执行的计算:加减乘除
转置数据:将行变成列,或者列变成行
基本语法:
对象.PasteSpecial(Paste,Operation,SkipBlanks,Transpose)
参数说明:
Paste:指定粘贴的内容类型(值、格式、公式等)
Operation:指定粘贴时执行的运算(加减乘除)
SkipBlanks:是否跳过空白单元格
Transpose:是否转置数据(关于转置数据是要注意的是,粘贴时只需要选择目标单元格的起始单元格,如果粘贴的目标是一个单元格区域,那么相当于把那一个区域的所有单元格都作为起始单元格粘贴一遍,会粘贴出一片比较大的区域)
' 只粘贴值
Range("A1:B5").Copy
Range("D1").PasteSpecial xlPasteValues
' 只粘贴格式
Range("A1:B5").Copy
Range("D1").PasteSpecial xlPasteFormats
' 粘贴并相加
Range("A1:B5").Copy
Range("D1").PasteSpecial Paste:=xlPasteAll, Operation:=xlPasteSpecialOperationAdd
' 转置数据
Range("A1:B5").Copy
Range("D1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
5.单元格进入自动编辑的状态
当光标选择单元格时无需双击,自动进入编辑状态,如下面的代码所示
以下代码可以实现,在第三列(C列)的任意 非空 单元格中点击,自动进入编辑状态:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 3 And Target.Count = 1 Then
If Target <> "" Then
Application.SendKeys "{F2}"
End If
End If
End Sub
如果想实现,点击任意单元格进入编辑,可以使用以下的代码:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
Application.SendKeys "{F2}"
End If
End Sub
6.禁用单元格拖放
在工作表中可以拖放单元格右下角的小十字对单元格内容进行复制等操作,如果不希望用户进行此操作可以禁用单元格拖放功能,
对指定的单元格区域禁止用户拖拽
' 这是工作表的SelectionChange事件处理程序
' 每当用户在该工作表中选择不同的单元格或范围时,这个过程就会被自动触发
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 检查用户选择的单元格(Target)是否与A1:A15范围有交集
' Application.Intersect 函数返回两个范围的交集
' 如果没有交集,则返回Nothing
If Not Application.Intersect(Target, Range("A1:A15")) Is Nothing Then
' 如果选择的单元格在A1:A15范围内
' 禁用单元格的拖放功能
' 这可以防止用户意外移动或复制这个范围内的数据
Application.CellDragAndDrop = False
Else
' 如果选择的单元格不在A1:A15范围内
' 启用拖放功能
' 这允许用户在工作表的其他区域正常使用拖放功能
Application.CellDragAndDrop = True
End If
End Sub
7.单元格中的数据有效性
' 这个子过程用于设置A1:A10范围的数据验证规则
Sub Validation()
' 使用With语句来简化对Range("A1:A10")的Validation属性的多次引用
With Range("A1:A10").Validation
' 删除该范围内现有的所有数据验证规则
' 这确保我们在一个"干净"的状态下开始
.Delete
' 添加新的数据验证规则
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="1,2,3,4,5,6,7,8"
' 注意:
' - xlValidateList: 允许用户从预定义列表中选择
' - xlValidAlertStop: 如果输入无效,会阻止用户输入并显示错误消息
' - Operator:=xlBetween 在列表验证中不起作用,但保留为了完整性
' - Formula1: 定义了允许的值列表,用户只能输入这些值
End With
End Sub
8.在单元格中写入公式
以下代码会让C列的结果等于A列与B列同一行单元格相加的和,Excel会自动调整C列中的单元格引用
Sub rngFormula()
Sheet2.Range("C1:C10").Formula = "=sum(A1+B1)"
End Sub
FormulaR1C1
FormulaR1C1 是 Excel VBA 中一个非常有用的属性,它与我们刚才讨论的 R1C1 引用样式直接相关。让我详细解释一下 FormulaR1C1 的用途和优势:
FormulaR1C1 的主要用途:
设置公式:
FormulaR1C1 允许您使用 R1C1 样式的引用来设置单元格或范围的公式。
保持公式一致性:
当您需要在不同位置应用相同的相对引用公式时,FormulaR1C1 特别有用。
简化代码:
在某些情况下,使用 FormulaR1C1 可以使您的 VBA 代码更简洁、更易于理解。
FormulaR1C1 的优势:
位置无关性:
R1C1 样式的公式不依赖于特定的单元格位置,这使得在不同位置应用相同逻辑的公式变得更容易。
便于循环操作:
在使用循环为多个单元格设置公式时,FormulaR1C1 通常更方便。
更直观的相对引用:
R1C1 样式使得相对引用更加明确和直观。
示例:
让我们看一个使用 FormulaR1C1 的例子,并与普通的 Formula 属性进行比较:
Sub CompareFormulaTypes()
' 使用普通的 Formula
Range("A1:A10").Formula = "=B1*C1"
' 使用 FormulaR1C1
Range("D1:D10").FormulaR1C1 = "=RC[1]*RC[2]"
End Sub
在这个例子中:
Formula 版本在 A1:A10 范围内设置公式,Excel 会自动调整B和C的引用。
FormulaR1C1 版本在 D1:D10 范围内设置公式,”RC[1]”表示当前行的右边一列,”RC[2]”表示当前行的右边两列。
FormulaR1C1 的特殊用途:
创建固定偏移的公式:
例如,始终引用左边第二列和第三列的单元格。
在循环中动态生成公式:
当您需要根据循环变量创建公式时,FormulaR1C1 通常更容易操作。
处理大范围的公式填充:
对于非常大的范围,使用 FormulaR1C1 可能会提高性能。
总的来说,FormulaR1C1 提供了一种更灵活、更强大的方式来在 VBA 中处理公式,特别是在处理相对引用和大范围操作时。理解和使用 FormulaR1C1 可以让您的 VBA 代码更加高效和灵活。
判断单元格公式是否存在错误
Sub FormulaIsError()
If VBA.IsError(Range("A1").Value) = True Then
MsgBox "A1 单元格格式错误类型为:" & Range("A1").Text
Else
MsgBox "A1 单元格公式结果为:" & Range("A1").Value
End If
End Sub
9.合并单元格操作
判断单元格区域是否存在合并单元格
如果工作表中有合并单元格则弹出提示
Function HasMergedCells(ws As Worksheet) As Boolean
Dim cell As Range
For Each cell In ws.UsedRange
If cell.MergeCells Then
HasMergedCells = True
Exit Function
End If
Next cell
HasMergedCells = False
End Function
Sub CheckForMergedCells()
Dim ws As Worksheet
Set ws = ActiveSheet ' 或指定特定工作表,如 Worksheets("Sheet1")
If HasMergedCells(ws) Then
MsgBox "工作表中存在合并单元格。"
Else
MsgBox "工作表中没有合并单元格。"
End If
End Sub
合并内容相同的连续单元格
以下表格中,部门列的内容存在重复,可以将某一列的连续重复单元格合并为一个大的单元格
序号 | 姓名 | 部门 | 职务 | 社保号码 | 医保号码 | 住房公积金号码 |
1 | 马海燕 | 办公室 | 办事员 | 074472 | 0046071 | 1003534950 |
2 | 王双 | 办公室 | 办事员 | 0132789 | 0058148 | 1819600 |
3 | 王晓倩 | 办公室 | 协理员 | 119340 | 58147 | 1009376 |
4 | 刘芳 | 办公室 | 外借 | T20209004 | 3618 | 1002782963 |
5 | 吴晓春 | 办公室 | 门卫 | 0103918 | 0058155 | 1011263 |
6 | 张启红 | 办公室 | 门卫 | 0012180 | 0058158 | 1003903 |
7 | 邱建辉 | 办公室 | 协理员 | 0100053 | 0058146 | 1009747 |
8 | 邱秦 | 办公室 | 驾驶员 | 0012139 | 0058150 | 0999827 |
9 | 陆卫东 | 办公室 | 驾驶员 | 0168403 | 0073627 | 1003553667 |
10 | 唐吉娣 | 办公室 | 门卫 | 0020171 | 0058153 | 1009864 |
11 | 唐朝义 | 办公室 | 副主任 | 0119338 | 0058152 | 1009142 |
12 | 徐玲秋 | 办公室 | 门卫 | 0098504 | 0058157 | 1009981 |
13 | 钱洲明 | 办公室 | 协理员 | 12131 | 58151 | 1006220 |
14 | 朱新忠 | 生技科 | 副科长 | 0012122 | 0058237 | 1002382 |
15 | 江留瑜 | 生技科 | 办事员 | 0012191 | 0058238 | 0999690 |
16 | 李志成 | 生技科 | 科长 | 0012132 | 0058232 | 1006688 |
17 | 李林军 | 生技科 | 办事员 | 0012154 | 0058169 | 1005929 |
18 | 徐汉清 | 生技科 | 协理员 | 0012133 | 0058165 | 1006571 |
19 | 王新华 | 财务科 | 科长 | 0012127 | 0058160 | 1000256 |
20 | 刘小专 | 财务科 | 现金会计 | 0121561 | 0058164 | 1011868 |
21 | 吴丽雅 | 财务科 | 总账会计 | 0012121 | 0058162 | 1000590 |
22 | 张萍 | 财务科 | 协理员 | 0012128 | 0058161 | 1000473 |
23 | 袁竹平 | 财务科 | 辅助会计 | 0012194 | 0058241 | 1006708 |
代码为(需要指定重复内容所在的位置):
Sub MergeSimilarCells()
Dim ws As Worksheet
Dim lastRow As Long
Dim col As Long
Dim i As Long, j As Long
' 设置工作表
Set ws = ActiveSheet ' 或者指定特定工作表,如 Worksheets("Sheet1")
' 获取最后一行的行号
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' 遍历每一列(从A列到F列)
For col = 1 To 6 ' A到F列
i = 1
While i <= lastRow
j = i + 1
' 查找连续相同的单元格
While j <= lastRow And ws.Cells(j, col).Value = ws.Cells(i, col).Value
j = j + 1
Wend
' 如果找到连续相同的单元格,则合并
If j > i + 1 Then
ws.Range(ws.Cells(i, col), ws.Cells(j - 1, col)).Merge
' 设置合并后的单元格格式
With ws.Cells(i, col)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End If
i = j
Wend
Next col
End Sub
10.录入数据后单元格自动保护
' 这是一个工作表事件过程,每当用户在工作表中选择不同的单元格时触发
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 启用错误处理,如果出现错误,代码将继续执行而不会中断
On Error Resume Next
' 解除工作表保护,密码是 "000"
' 这样可以临时允许对单元格进行修改
Sheet1.Unprotect Password:="000"
' 检查选中的单元格(Target)是否有值
If Target.Value <> "" Then
' 如果单元格有值,则将其锁定
' 这可以防止用户进一步修改该单元格
Target.Locked = True
' 重新保护工作表,使用相同的密码 "000"
' 这样可以确保其他单元格仍然受到保护
Sheet1.Protect Password:="000"
End If
End Sub
1 thought on “1.Range对象——《VBA常用技巧代码解析》”