excel - 查找范围内符合特定条件的所有值并返回每一行VBA

Question

我正在寻找一些代码来搜索范围并返回该范围内符合特定条件的每个单元格的行号并列出这些行。

以前我只需要第一个值，因此一直使用代码:

Dim Criteria1 As Single
Dim Criteria2 As Single
Dim Required As Integer
Dim Range1 As Range
Dim GearNeg1 As Integer

SetColumn = 24
Set Range1 = Sheets("X").Range("A2:BT72").Columns(SetColumn).Cells
Criteria1 = Sheets("X").Range("P111").Value
Criteria2 = Sheets("X").Range("Q111").Value

For Each Cell In Range1

    If Cell.Value < Criteria1 And Cell.Value > Criteria2 Then

        Required = Cell.row

        Exit For

    End If
Next

我一直在尝试添加一个 for 循环，以将符合条件的值的所有行值返回到列表中。然而我很挣扎，似乎每次都只能达到找到的第一个值。

Answer 1

您可以将范围读入数组，循环数组并将符合条件的行连接成字符串。我使用从第 2 行开始的事实，并且我使用基于 1 的数组来确定行，即我将 1 添加到 i 的值，i 是数组中合格值所在的索引。

你也可以使用

required = required & "," & i + ws.Range("A2:BT72").Row - LBound(arr)

VBA:

Option Explicit
Public Sub test()
    Dim criteria1 As Single, criteria2 As Single, required As String
    Dim arr(), ws As Worksheet, setColumn As Long, i As Long

    Set ws = ThisWorkbook.Worksheets("X")
    setColumn = 24
    arr = Application.Transpose(ws.Range("A2:BT72").Columns(setColumn).Value)

    criteria1 = ws.Range("P111").Value
    criteria2 = ws.Range("Q111").Value

    For i = LBound(arr) To UBound(arr)
        If arr(i) < criteria1 And arr(i) > criteria2 Then
            required = required & "," & i + 1
        End If
    Next

    required = Replace$(required, ",", vbNullString, 1, 1)

    Debug.Print required
End Sub