多条件匹配/搜索vba

Sub MultiCriteriaSearch()
    Dim searchRange As Range
    Dim criteriaRange As Range
    Dim resultRange As Range
    Dim criteria1 As Variant
    Dim criteria2 As Variant
    Dim foundCells As Range
    Dim cell As Range
    
    ' 设置搜索范围
    Set searchRange = Sheet1.Range("A1:A10")
    
    ' 设置条件范围
    Set criteriaRange = Sheet1.Range("B1:B10")
    
    ' 设置结果范围
    Set resultRange = Sheet1.Range("C1:C10")
    
    ' 设置条件1和条件2
    criteria1 = "条件1"
    criteria2 = "条件2"
    
    ' 清空结果范围
    resultRange.ClearContents
    
    ' 遍历搜索范围
    For Each cell In searchRange
        ' 检查条件1和条件2是否匹配
        If cell.Value = criteria1 And criteriaRange.Cells(cell.Row, 1).Value = criteria2 Then
            ' 将匹配的结果写入结果范围
            If foundCells Is Nothing Then
                Set foundCells = cell
            Else
                Set foundCells = Union(foundCells, cell)
            End If
        End If
    Next cell
    
    ' 将结果范围设置为匹配的单元格
    If Not foundCells Is Nothing Then
        foundCells.Copy resultRange
    End If
End Sub