01 工作表
查找指定内容并标记
对单元格(Range)对象的操作非常重要，我们对数据的处理过程，几乎都是在循环、判断内、对单元格对象处理的过程。
我们用一个"查找符合条件的单元格"的案例，来重新认识下"单元格的查找与引用、单元格设置及程序跳转"。
运行视频：
源码下载：
描述：
在一个单元格区域内，有数值、文本字符串等，如何快速定位到符合查找条件的单元格并设置底色？
样本示例：
表单空间的插入和指向宏过程
结果示例：
需求分析：
- 1、支持自主选择查找区域；
- 2、支持字符串查找，模糊和绝对匹配均可；
- 3、支持数值查找，适配"比较和逻辑运算符"；
- 4、符合条件的单元格改变底色；
- 5、在表单里设置按钮，一键执行代码过程。
VBA实现过程：
- 1.Application.InputBox(Text, Type:=8)，自主选择，Type类型是单元格；
- 2.if判断查找条件，是否包含*、比较运算符、逻辑运算符等字符，在GoTo **跳转至不同的查找方法；
- 3..Find()查找方法，执行效率最高，LookAt的参数对应不同的查找方式；
- 4、主程序逻辑实现过程
- ①判断查找条件：不同的条件跳转到不同的执行语句，
- ②.Find()查找方法：支持模糊匹配还绝对匹配查找条件，
- ③有运算符的查找条件：Evaluate函数将工作表公式转化为值，
- ④符合条件的单元格：.Interior.ColorIndex属性设置单元格底色；
- 5.结束！
示例代码
复制成功!
1
Sub 查找并标识()
'----------------------------------------------------------
'声明三个ragne对象变量
Dim set_value, Firstaddress, txt As String
Dim Choose_rng, rng, C As Range
Dim check_value As Long
On Error Resume Next
'选择从中查找的单元格区域
Set Choose_rng = Application.InputBox("选择被查找的单元格或单元格区域", Type:=8)
If WorksheetFunction.CountA(Choose_rng) = 0 Then MsgBox "选择单元格区域为空": Exit Sub
On Error GoTo 0
'设置条件内容
txt = "说明：" & Chr(10) & "1、文本、数值均可" & Chr(10) & "2、文本（用通配符*查找包含关系,如：张三、*张三*)" & Chr(10) & "3、数值（支持比较运算符，如60、>=60、>=60" & "and" & "<70)"
set_value = Application.InputBox(txt, Title:="请输入查找的条件", Type:=1 + 2)
If Len(set_value) = 0 Then MsgBox "未设置条件": Exit Sub
'判断不同的条件内容，跳转到不同的应用
On Error Resume Next
check_value = set_value + 1
If Err.Number > 0 Then
If Left(set_value, 1) = "*" Or Right(set_value, 1) = "*" Then
set_value = Replace(set_value, "*", "")
GoTo A:
ElseIf set_value Like "*#*" Then
If InStr(1, set_value, "and") Then
GoTo E:
Else
If InStr(1, set_value, ">=") Or InStr(1, set_value, ">") Or InStr(1, set_value, "<=") Or InStr(1, set_value, "<") Then
set_value = set_value
GoTo D:
Else
MsgBox set_value & "不是比较运算符"
Exit Sub
End If
End If
Else
GoTo B:
End If
Else
set_value = set_value * 1
GoTo B
End If
On Error GoTo 0
A: '当包含模糊查找的*字符时，跳转到A段执行
With Choose_rng
Set C = .Find(set_value, LookAt:=xlPart, LookIn:=xlValues) '查找方式是 :=xlPart模糊查找
If Not C Is Nothing Then
Firstaddress = C.Address '把当前查找到的单元格地址赋给Firstaddress
Do
C.Interior.ColorIndex = 6 '找到符合条件单元格后，设置底色
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Firstaddress '继续查找，直到查找到单元格地址和第一个相同，表示搜索完毕！结束
Else
MsgBox "不存在符合条件的单元格", 64, "提示"
End If
Exit Sub
End With
B: '正常查找字符或字符串，跳转到B段执行
With Choose_rng
Set C = .Find(set_value, LookAt:=xlWhole, LookIn:=xlValues) '查找方式是 :=xlWhole绝对匹配
If Not C Is Nothing Then
Firstaddress = C.Address
Do
C.Interior.ColorIndex = 6
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address <> Firstaddress
Else
MsgBox "不存在符合条件的单元格", 64, "提示"
End If
Exit Sub
End With
D: '当包含比较运算符‘=、>、<’等时，跳转到D段执行
For Each rng In Choose_rng
If Len(rng) > 0 And WorksheetFunction.IsNumber(rng) Then
If Evaluate(rng.Value & set_value) Then 'Evaluate函数，在VBA中使用工作表公式
rng.Interior.ColorIndex = 6
End If
End If
Next rng
Exit Sub
E: '当包含逻辑运算符‘and’等时，跳转到E段执行
For Each rng In Choose_rng
If Len(rng) > 0 And WorksheetFunction.IsNumber(rng) Then
If Evaluate(rng.Value & Split(set_value, "and")(0)) And Evaluate(rng.Value & Split(set_value, "and")(1)) Then
rng.Interior.ColorIndex = 6
End If
End If
Next rng
Exit Sub
End Sub
请开发者喝杯咖啡！