vba 是否可以在不循环的情况下用符合特定条件的行号填充数组？
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12921350/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Is it possible to fill an array with row numbers which match a certain criteria without looping?
提问by The_Barman
I would like to fill an array in VBA with the row numbers of only rows which meet a certain criteria. I would like the fastest method possible (for example, something like RowArray = index(valRange=valMatch).row)
我想用满足特定条件的行的行号填充 VBA 中的数组。我想要最快的方法（例如，类似的东西RowArray = index(valRange=valMatch).row）
Below is the code for the (slow) range loop.
下面是（慢）范围循环的代码。
Current Code
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
回答by brettdj
Still around 2-3 times the time of the efficient variant array from Chris, but the technique is powerful and has application beyond this question
仍然是 Chris 的高效变体阵列的时间的 2-3 倍左右，但该技术非常强大，并且具有超越这个问题的应用
One point to note is that Application.Transposeis limited to 65536 cells, so a longer range needs to be "chunked" into pieces.
需要注意的一点是，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
回答by chris neilsen
First copy the range to a variant array , then loop over the array
首先将范围复制到变体数组，然后遍历数组
Arr = rngval
For I = 1 to ubound(arr)
If arr(I,1) = valMatch Then RowArray(x) = I: x = x + 1
Next
回答by chris neilsen
There is an assumption in the question title: that a looping solution is slow and a non-looping solution is faster. So, I conducted some comparisons to check that.
问题标题中有一个假设：循环解决方案很慢，非循环解决方案更快。所以，我进行了一些比较来检查。
Test Case
测试用例
I created some sample data consisting of 50,000 samples, and 50% matching values. For the fastest methods I created two more sample sets, again with 50,000 rows and one with 10% matching rows, another with 90% matching row.
我创建了一些包含 50,000 个样本和 50% 匹配值的样本数据。对于最快的方法，我又创建了两个样本集，同样有 50,000 行，一个有 10% 的匹配行，另一个有 90% 的匹配行。
I ran each of the posted methods over this data in a loop, repeating the logic 10 times (so times are for processing a total of 500,000 rows).
我在循环中对这些数据运行了每个发布的方法，重复逻辑 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
So the moral is clear: just because it includes a loop, doesn't make it slow. What isslow is access the worksheet, so you should make every effort to minimise that.
所以道理很清楚：仅仅因为它包含一个循环，并不会让它变慢。什么是慢是获得工作表，所以你应该尽一切努力，以尽量减少。
UpdateAdded test of Brettdj's comment: single line of code
更新添加了对 Brettdj 评论的测试：单行代码
For completeness sake, here's my solution
为了完整起见，这是我的解决方案
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
回答by Scott Holtzman
Building off what others have offered here, I've combined both methods along with some string manipulation to get the exact row numbers of any given range containing the desired match without looping.
在其他人提供的内容的基础上，我将这两种方法与一些字符串操作结合起来，以获取包含所需匹配项的任何给定范围的确切行号，而无需循环。
The only note that differs from your code is that RowArray()is a Stringtype. However, you could convert it to Long using CLngas you strip numbers out as needed, if you need to do that.
与您的代码不同的唯一注意事项是它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
回答by Charles Williams
You may want to look at Find vs Match vs Variant Arraywhich concludes that the variant array approach is fastest unless the hit density is very low.
您可能需要查看Find vs Match vs Variant Array得出的结论是，除非命中密度非常低，否则变体数组方法最快。
But the fastest method of all is only for sorted data and exact match: use binary search to find the fisrt and last ocurrences and then get that subset of data into a variant array.
但最快的方法仅适用于已排序的数据和精确匹配：使用二分搜索找到第一个和最后一个出现，然后将该数据子集放入一个变体数组中。
回答by Kamran Hyder
Everyone, thanks for your individual inputs.
各位，感谢您的个人意见。
ExactaBox, your solution has been much helpful to me. However, there is a catch in returning 0 value through formula
ExactaBox，您的解决方案对我很有帮助。但是，通过公式返回 0 值有一个问题
rFormula.FormulaR1C1= "=IF(RC[-1]=""" & valMatch & """,ROW(RC),0)".
rFormula.FormulaR1C1= "=IF(RC[-1]=""" & valMatch & """,ROW(RC),0)".
Since VBA Filter function filters out values by making string comparisons, it would also filter out row numbers having zeroes in them. For example valid row numbers, 20, 30, 40 etc. shall also be filtered out because they contain zeroes, so it would be better to write a string in place of 0 in the formula, which could therefore be:
由于 VBA 过滤器函数通过进行字符串比较来过滤掉值，因此它还会过滤掉包含零的行号。例如，有效的行号 20、30、40 等也应该被过滤掉，因为它们包含零，所以最好在公式中写一个字符串来代替 0，因此可以是：
rFormula.FormulaR1C1= "=IF(RC[-1]=""" & valMatch & """,ROW(RC),""Valid"")"
rFormula.FormulaR1C1= "=IF(RC[-1]=""" & valMatch & """,ROW(RC),""Valid"")"
as was also suggested by brettdj above, who used "x" string as the last argument.
正如上面 brettdj 所建议的，他使用“x”字符串作为最后一个参数。
回答by ExactaBox
You have your range hard-coded in the example. Do you have a spare column to the right? If so, you could fill the cells to the right with 0 if it's not a match, or the row number if it is. Then pull that into an array and filter it. No loops:
您在示例中对范围进行了硬编码。右边有备用柱子吗？如果是这样，如果不匹配，您可以用 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
I have to credit Jon49 at One-dimensional array from Excel Rangefor the Application.Transpose trick to get a 1-d array.
对于 Application.Transpose 技巧，我必须将Excel 范围中的一维数组归功于 Jon49，以获得一维数组。
回答by John Bustos
I still have a loop, but only through the necessary rows to populate the array:
我仍然有一个循环，但只能通过必要的行来填充数组：
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
