Question

我想在VBA中填充一个只有符合某个条件的行数的行数。我想尽可能快的方法（例如，像RowArray = index(valRange=valMatch).row）

下面是（慢）范围循环的代码。

Current Code

Sub get_row_numbers()

Dim RowArray() As Long
Dim valRange As Range
Dim valMatch As String

Set valRange = ActiveSheet.Range("A1:A11")
valMatch = "aa"
ReDim RowArray(WorksheetFunction.CountIf(valRange, valMatch) - 1)

For Each c In valRange
    If c.Value = valMatch Then RowArray(x) = c.Row: x = x + 1
Next c    
End Sub

Answer 1

仍然是克里斯有效变体数组时间的2-3倍，但该技术功能强大且超出了这个问题的应用

需要注意的一点是，Application.Transpose仅限于65536个单元格，因此较长的范围需要“分块”成碎片。

Sub GetEm()
Dim x
x = Filter(Application.Transpose(Application.Evaluate("=IF(A1:A50000=""aa"",ROW(A1:a50000),""x"")")), "x", False)
End Sub

Answer 2

首先将范围复制到变量数组，然后遍历数组

Arr = rngval
For I = 1 to ubound(arr)
    If arr(I,1) = valMatch Then RowArray(x) = I: x = x + 1
Next

Answer 3

问题标题中有一个假设：循环解决方案很慢，非循环解决方案更快。所以，我进行了一些比较来检查。

测试用例

我创建了一些包含50,000个样本和50％匹配值的样本数据。对于最快的方法，我创建了两个样本集，同样有50,000行，一个有10％匹配行，另一个有90％匹配行。

我在循环中对这些数据运行了每个已发布的方法，重复逻辑10次（所以时间用于处理总共500,000行）。

                  50%        10%        90%  
ExactaBox        1300       1240       1350  ms
Scott Holtzman 415000         
John Bustos     12500       
Chris neilsen     310        310        310
Brettdj           970        970        970
OP               1530       1320       1700

所以道德很明确：仅仅因为它包含一个循环，不会让它变慢。什么慢是访问工作表，所以你应该尽一切努力减少它。

<强>更新增加了对Brettdj评论的测试：单行代码

为了完整起见，这是我的解决方案

Sub GetRows()
    Dim valMatch As String
    Dim rData As Range
    Dim a() As Long, z As Variant
    Dim x As Long, i As Long
    Dim sCompare As String

    Set rData = Range("A1:A50000")
    z = rData
    ReDim a(1 To UBound(z, 1))
    x = 1
    sCompare = "aa"
    For i = 1 To UBound(z)
        If z(i, 1) = sCompare Then a(x) = i: x = x + 1
    Next
    ReDim Preserve a(1 To x - 1)    
End Sub

Answer 4

基于其他人提供的内容，我结合了两种方法以及一些字符串操作，以获得包含所需匹配而不循环的任何给定范围的确切行数。

与您的代码不同的唯一注释是RowArray()是String类型。但是，如果需要，可以根据需要使用CLng将其转换为Long。

Sub get_row_numbers()

Dim rowArray() As String, valRange As Range, valMatch As String
Dim wks As Worksheet, I As Long, strAddress As String    
Set wks = Sheets(1)
valMatch = "aa"

With wks    
    Set valRange = .Range("A1:A11")        
    Dim strCol As String
    strCol = Split(valRange.Address, "$")(1)
    '-> capture the column name of the evaluated range
        '-> NB -> the method below will fail if a multi column range is selected

    With valRange        
        If Not .Find(valMatch) Is Nothing Then
        '-> make sure valMatch exists, otherwise SpecialCells method will fail

            .AutoFilter 1, valMatch                    
            Set valRange = .SpecialCells(xlCellTypeVisible)
            '-> choose only cells where ValMatch is found

            strAddress = valRange.Address '-> capture address of found cells
            strAddress = Replace(Replace(strAddress, ":", ""), ",", "") '-> remove any commas and colons
            strAddress = Replace(strAddress, "$" & strCol & "$", ",") '-> replace $column$ with comma
            strAddress = Right(strAddress, Len(strAddress) - 1) '-> remove leading comma

            rowArray() = Split(strAddress, ",")

            '-> test print
            For I = 0 To UBound(rowArray())                    
                Debug.Print rowArray(I)                        
            Next

        End If 'If Not .Find(valMatch) Is Nothing Then            
    End With ' With valRange        
End With 'With wks

End Sub

Answer 5

您可能需要查看Find vs Match vs Variant Array，其结论是变体数组方法最快，除非命中密度非常低。

但最快的方法是仅对排序数据和完全匹配：使用二进制搜索来查找fisrt和last ocurrences，然后将该数据子集转换为变量数组。

Answer 6

我仍然有一个循环，但只能通过必要的行来填充数组：

Sub get_row_numbers()

Dim RowArray() As Long
Dim valRange As Range
Dim valMatch As String

Set valRange = ActiveSheet.Range("A1:A11")
valMatch = "aa"
ReDim RowArray(WorksheetFunction.CountIf(valRange, valMatch) - 1)

Dim c As Range
Dim x As Integer
Set c = valRange.Find(What:=valMatch, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlNext)

Do
  RowArray(x) = c.Row
  Set c = valRange.FindNext(after:=c)
  x = x + 1
Loop Until x = UBound(RowArray) + 1


End Sub

Answer 7

您在示例中对您的范围进行了硬编码。你右边有一个备用栏吗？如果是这样，你可以将单元格填充到右边，如果它不匹配则为0，如果是，则填充行号。然后将其拉入阵列并过滤它。没有循环：

Sub NoLoop()

Dim valMatch As String
Dim rData As Excel.Range, rFormula As Excel.Range
Dim a As Variant, z As Variant

    Set rData = ThisWorkbook.Worksheets(1).Range("A1:A11") 'hard-coded in original example
    Set rFormula = ThisWorkbook.Worksheets(1).Range("B1:B11") ' I'm assuming this range is currently empty
    valMatch = "aa" 'hard-coded in original example

    'if it's a valid match, the cell will state its row number, otherwise 0
    rFormula.FormulaR1C1 = "=IF(RC[-1]=""" & valMatch & """,ROW(RC),0)"

    a = Application.Transpose(rFormula.Value)
    z = Filter(a, 0, False) 'filters out the zeroes, you're left with an array of valid row numbers

End Sub

我必须在One-dimensional array from Excel Range处将Jon49归功于Application.Transpose技巧以获得一维数组。

Answer 8

每个人，感谢您的个人意见。

ExactaBox，您的解决方案对我很有帮助。但是，通过公式

返回0值有一个问题

rFormula.FormulaR1C1= "=IF(RC[-1]=""" & valMatch & """,ROW(RC),0)".

由于VBA过滤器功能通过进行字符串比较来过滤掉值，因此它还会过滤掉其中包含零的行号。例如，有效的行号，20,30,40等也应该被过滤掉，因为它们包含零，所以最好在公式中用一个字符串代替0，这可能是：

rFormula.FormulaR1C1= "=IF(RC[-1]=""" & valMatch & """,ROW(RC),""Valid"")"

正如上面的brettdj所建议的那样，他使用“x”字符串作为最后一个参数。

是否可以使用符合特定条件的行号填充数组而不进行循环？

8 个答案: