是否有可能填充行号符合一定的标准没有循环的数组？
我想在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
仍然是来自Chris的高效变体arrays的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
首先将范围复制到变体数组，然后遍历数组
Arr = rngval For I = 1 to ubound(arr) If arr(I,1) = valMatch Then RowArray(x) = I: x = x + 1 Next
问题标题中有一个假设：循环解决scheme速度慢，非循环解决scheme速度更快。 所以，我进行了一些比较来检查。
testing用例
我创build了一些由50,000个样本组成的样本数据，以及50％的匹配值。 对于最快的方法，我创build了两个更多的样本集，再次有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的评论testing：单行代码
为了完整起见，这是我的解决scheme
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
build立其他人在这里提供的，我已经结合这两种方法，以及一些string操作，以获得任何给定范围的确切行号包含所需的匹配没有循环 。
唯一不同于你的代码的是RowArray()是一个Stringtypes。 但是，如果您需要这样做，则可以根据需要将数字取出，然后使用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
你可能想看看发现VS匹配与变种arrays ，其结论是变体arrays方法是最快的，除非命中密度非常低。
但所有的最快方法只适用于sorting数据和精确匹配：使用二进制search来查找fisrt和最后的出现，然后将该数据子集获取到变体数组中。
我仍然有一个循环，但只有通过必要的行来填充数组：
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
在示例中，您的范围是硬编码的。 你有没有备用的专栏？ 如果是这样的话，你可以用右边的单元格填充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
我不得不称赞Jon49在Excel范围内的一维数组，以获得一维数组。
大家，谢谢你的个人意见。
ExactaBox，你的解决scheme对我很有帮助。 但是，通过公式还有一个返回值的问题
rFormula.FormulaR1C1= "=IF(RC[-1]=""" & valMatch & """,ROW(RC),0)".
由于VBA Filter函数通过进行string比较来过滤值，所以它也会过滤掉其中有零的行号。 例如，有效的行号，20,30,40等也应该被过滤掉，因为它们包含零，所以最好在公式中写一个string代替0，因此可以是：
rFormula.FormulaR1C1= "=IF(RC[-1]=""" & valMatch & """,ROW(RC),""Valid"")"
正如上面的brettdj所build议的，谁使用“x”string作为最后一个参数。