查找符合条件的内容并标记

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:
    With Choose_rng
        Set C = .Find(set_value, LookAt:=xlPart, LookIn:=xlValues)
        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
    
B:
    With Choose_rng
        Set C = .Find(set_value, LookAt:=xlWhole, LookIn:=xlValues)
        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:
    For Each rng In Choose_rng
        If Len(rng) > 0 And WorksheetFunction.IsNumber(rng) Then
            If Evaluate(rng.Value & set_value) Then
                rng.Interior.ColorIndex = 6
            End If
        End If
    Next rng
    Exit Sub
    
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
1：不同列、行、区域的相关内容的查找标记
2：自主修改部分代码做成小的应用
3：选择需要查找的单元格区域，自定义查找条件
源码视频演示
查找符合条件的内容并标记

目录
