Можно ли заполнить массив номерами строк, которые соответствуют определенным критериям без цикла?

Я хотел бы заполнить массив в 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" в качестве последнего аргумента.