11

我想用满足特定条件的行的行号填充 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
4

8 回答 8

12

仍然是 Chris 的高效变体阵列的 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
于 2012-10-25T03:29:14.630 回答
8

首先将范围复制到一个变体数组，然后遍历该数组

Arr = rngval
For I = 1 to ubound(arr)
    If arr(I,1) = valMatch Then RowArray(x) = I: x = x + 1
Next
于 2012-10-16T18:50:59.003 回答
4

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

测试用例

我创建了一些包含 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
于 2012-10-24T10:11:57.930 回答
3

在其他人在这里提供的基础上，我将这两种方法与一些字符串操作结合起来，以获得包含所需匹配的任何给定范围的确切行号，而无需循环。

与您的代码不同的唯一说明是它RowArray()是一种String类型。但是，如果需要，您可以根据需要将数字转换为 Long 使用CLng。

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
于 2012-10-22T17:50:39.053 回答
2

您可能想查看Find vs Match vs Variant Array得出的结论是，除非命中密度非常低，否则变体数组方法是最快的。

但最快的方法仅适用于排序数据和精确匹配：使用二进制搜索查找第一次和最后一次出现，然后将该数据子集放入一个变体数组中。

于 2012-10-25T07:35:32.200 回答
1

您在示例中对范围进行了硬编码。右边有备用柱子吗？如果是这样，如果不匹配，您可以使用 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

我必须将来自 Excel Range 的一维数组中的Jon49 归功于Application.Transpose 技巧以获得一维数组。

于 2012-10-24T05:52:56.653 回答
1

大家，感谢您的个人意见。

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”字符串作为最后一个参数。

于 2013-06-27T09:57:05.803 回答
1

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

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
于 2012-10-22T16:08:21.823 回答