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

【问题标题】：Find all values in a range that fit a certain criteria and return each row VBA查找范围内符合特定条件的所有值并返回每一行 VBA
【发布时间】：2019-04-04 09:44:06
【问题描述】：

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

以前我只需要第一个值，所以一直在使用代码：

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 循环以将满足条件的值的所有行值返回到列表中。但是我很挣扎，似乎每次都只能达到第一个值。

【问题讨论】：

你为什么这样做：Set Range1 = Sheets("X").Range("A2:BT72").Columns(SetColumn).Cells ？ SetColumn 是否有所不同？此外，请使用 Long 而不是 Integer 以避免潜在的溢出。
感谢您的建议，是的，setcolumn 确实因问题而异

标签： excel vba for-loop search

【解决方案1】：

您可以将范围读入一个数组，循环该数组并将符合条件的行连接成一个字符串。我使用您从第 2 行开始的事实，并且我使用基于 1 的数组来确定行，即我将 1 加到 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

【讨论】：

感谢 QHarr，效果很好！我的下一步是搜索这些行并在 2 个已知列上找到 2 个值。你有什么建议吗？
使用查找范围的方法。

【解决方案2】：

这是一个最小的示例，返回 Range A1:A30 的行，其中包含 X：

Public Sub TestMe()

    Dim rowValues As String
    Dim myCell As Range

    For Each myCell In Worksheets(1).Range("A1:A30")
        If myCell = "X" Then
            rowValues = Trim(rowValues & " " & myCell.Row)
        End If
    Next myCell

    Debug.Print rowValues

End Sub

这里通过连接完成返回：rowValues = Trim(rowValues & " " & myCell.Row)，需要Trim() 来减少第一个连接上的第一个" "。

【讨论】：