VBA 查找符合多条件的记录,其实很简单

Option Explicit


Private Sub UserForm_Initialize() '初始化窗体
    Dim intX&
    Dim aRes(1 To 56)
    For intX = 1 To 56
        aRes(intX) = intX
    Next
    With Me
        With .颜色
            .Font.Size = 11
            .List = aRes
            .ListIndex = 2
        End With
        .查找.Value = True
        .完整.Value = True
    End With
End Sub


Private Sub 区域选择_Click() '区域选择
    Dim Rng As Range
    Set Rng = Application.InputBox("数据来源", "请选择区域!!", ActiveCell.Address, , , , , 8)
    If Rng Is Nothing Then Exit Sub
    Set Rng = Intersect(Rng, Rng.Parent.UsedRange)
    Me.区域.Value = Rng.Address
End Sub


Private Sub 执行_Click()
    If Me.查找.Value Then
        Call Find_Value
    End If
End Sub


Sub Find_Value()
    Dim Rng As Range, Cell As Range, RngData As Range
    Dim strAddress$, strVal, strMatch$
    Set RngData = Range(Me.区域.Text)
    strVal = Me.查找内容.Text
    If Len(strVal) = 0 Then MsgBox "请输入查找内容", 64, "出错": Exit Sub
    With RngData
       .Interior.ColorIndex = 0 '初始化背景色
       strMatch = IIf(Me.完整.Value, xlWhole, xlPart) '匹配模式
       Set Cell = .Find(what:=strVal, LookIn:=xlValues, Lookat:=strMatch)
       If Cell Is Nothing Then MsgBox "[" & RngData.Address & "]区域中并无" & strVal, 64: Exit Sub
       strAddress = Cell.Address '记录第一个单元格地址
       Do
            If Rng Is Nothing Then
                Set Rng = Cell '初始化
            Else
                Set Rng = Union(Rng, Cell) '合并
            End If
            Set Cell = .FindNext(Cell) '查找下一个
       Loop Until Cell.Address = strAddress
       Rng.Interior.ColorIndex = Me.颜色.Text '标记背景颜色
       Me.标记.Caption = "总共找到了" & Rng.Count & "个" '写入找到多少个
    End With
End Sub