Можно ли заполнить массив номерами строк, которые соответствуют определенным критериям без цикла?
Я хотел бы заполнить массив в 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
Ответы
Ответ 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
Ответ 2
Сначала скопируйте диапазон в вариантный массив, затем перейдем к массиву
Arr = rngval
For I = 1 to ubound(arr)
If arr(I,1) = valMatch Then RowArray(x) = I: x = x + 1
Next
Ответ 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
Итак, мораль ясна: просто потому, что она включает цикл, она не замедляет работу. Медленным является доступ к рабочему листу, поэтому вы должны приложить все усилия, чтобы свести к минимуму это.
Обновление
Добавлен тест комментария Бреттда: одна строка кода
Для полноты, здесь мое решение
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
Ответ 4
Создав то, что предложили здесь другие, я объединил оба метода вместе с некоторыми строковыми манипуляциями, чтобы получить точные номера строк любого заданного диапазона, содержащие требуемое совпадение без цикла.
Единственное примечание, которое отличается от вашего кода, заключается в том, что 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
Ответ 5
Вы можете посмотреть Найти vs Match vs Variant Array, который заключает, что подход с вариантным массивом является самым быстрым, если плотность попадания очень низкая.
Но самый быстрый метод для всех - это только для отсортированных данных и точного соответствия: используйте бинарный поиск, чтобы найти fisrt и last ocurrences, а затем получите этот подмножество данных в массив вариантов.
Ответ 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
Ответ 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 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 для приложения Application.Transpose, чтобы получить 1-й массив.
Ответ 8
Все, спасибо за ваши индивидуальные входы.
ExactaBox, ваше решение было очень полезно для меня. Тем не менее, есть улов в возвращении 0 значения по формуле
rFormula.FormulaR1C1= "=IF(RC[-1]=""" & valMatch & """,ROW(RC),0)".
Так как функция VBA Filter отфильтровывает значения, производя сравнение строк, она также отфильтровывает номера строк с нулями в них. Например, допустимые номера строк, 20, 30, 40 и т.д. Также должны быть отфильтрованы, поскольку они содержат нули, поэтому лучше было бы написать строку вместо 0 в формуле, которая могла бы быть:
rFormula.FormulaR1C1= "=IF(RC[-1]=""" & valMatch & """,ROW(RC),""Valid"")"
как также было предложено выше brettdj, который использовал "x" в качестве последнего аргумента.