excel - 如何将多个条件应用于.Find？

Question

我改编了我在网上找到的代码。

• 它在 A 列中找到字符串“car”并将行作为数组返回
• 它将一个变量分配给数组的长度（找到多少匹配项）
• 它分配一个变量以生成一个介于 0 和数组长度之间的随机数
• 然后它将随机匹配行的值打印到 K3

Dim myArray() As Variant
Dim x As Long, y As Long
Dim msg As String

With ActiveSheet.Range("A1:A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row)

    Set c = .find("Car", LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            ReDim Preserve myArray(y)
            myArray(y) = c.Row
            y = y + 1
            Set c = .findNext(c)
            If c Is Nothing Then
                GoTo DoneFinding
            End If
        Loop While c.Address <> firstAddress
    End If

DoneFinding:
End With

For x = LBound(myArray) To UBound(myArray)
    msg = msg & myArray(x) & " "
Next x

ArrayLen = UBound(myArray) - LBound(myArray)

random_index = WorksheetFunction.RandBetween(0, ArrayLen)

MsgBox myArray(random_index)

Dim test As String

test = "B" & myArray(random_index)

Range("K3").Value = Range(test)

例子

我正在努力调整查找代码以允许多个标准。所以在我的例子中，它找到了“汽车”。如果我想查找在 A 列中包含“Car”而在 D 列中包含“Red”的匹配项怎么办？

我试过了

With ActiveSheet.Range("A1:A" & "D1:D" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row & ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row)
     Set c = .find("Car", "Red", LookIn:=xlValues)

我在 Set 行上得到类型不匹配。

如果它令人困惑，它目前会寻找一个字符串，例如“Car”，但我最终会将它链接到将分配给数据验证列表的变量。因此，如果用户从下拉列表中选择“汽车”，这就是它将搜索的内容。

标签： excelvba

Answer 1

也许高级过滤器可以满足您的需求：

示例代码

Option Explicit

Public Sub FilterData()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("YourSheetName")

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim CriteriaRange As Range
    Set CriteriaRange = ws.Range("A1", "E2")

    Dim DataRange As Range
    Set DataRange = ws.Range("A4", "E" & LastRow)

    DataRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=CriteriaRange, Unique:=False
End Sub

Public Sub ShowAll()
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
End Sub

---

根据评论编辑：

您可以使用高级过滤器，然后遍历过滤器结果：

Option Explicit

Public CurrentRow As Long

Public Sub FilterData()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("YourSheetName")

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim CriteriaRange As Range
    Set CriteriaRange = ws.Range("A1", "E2")

    Dim DataRange As Range
    Set DataRange = ws.Range("A4", "E" & LastRow)

    DataRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=CriteriaRange, Unique:=False
End Sub

Public Sub ShowAll()
    On Error Resume Next
    ActiveSheet.ShowAllData
    CurrentRow = 1
    On Error GoTo 0
End Sub


Public Sub GetNextResult()
    FilterData

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("YourSheetName")

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim DataRange As Range
    Set DataRange = ws.Range("A4", "E" & LastRow)

    Dim FilteredData As Range
    Set FilteredData = DataRange.Resize(ColumnSize:=1).SpecialCells(xlCellTypeVisible)

    If CurrentRow + 1 > FilteredData.Cells.Count Then
        CurrentRow = 1
    End If

    CurrentRow = CurrentRow + 1
    Dim i As Long
    Dim Cell As Variant
    For Each Cell In FilteredData
        i = i + 1
        If i = CurrentRow Then
            Cell.EntireRow.Select
            'or
            'MsgBox Cell.Value & vbCrLf & Cell.Offset(0, 1) & vbCrLf & Cell.Offset(0, 2) & vbCrLf & Cell.Offset(0, 3) & vbCrLf & Cell.Offset(0, 4)
        End If
    Next Cell
End Sub