Как сделать функцию рекурсивной

Question

У меня огромный набор данных (почти 12 тыс. Строк). Я хочу найти в столбце A ключевое слово (например, name "), а затем переместить соответствующее ему значение из столбца B на новый лист. У меня это работает, но я не могу понять, как сделать его рекурсивным, чтобы оно выглядело на всех 12 тыс. записи в столбце А. Пожалуйста, помогите.

См. Скрипт ниже, который работает, но должен быть рекурсивным

Sub Test()

With Sheets("original")
    If .Range("A24").Value = "Name        " Then
        Sheets("new").Range("A1").Value = .Range("B24").Value
    End If
End With

End Sub

Answer 1

Вот пример с использованием стандартных 2-D массивов.Словарь - это еще одна опция на основе массива.Автофильтр или расширенный фильтр устраняет необходимость в массивах и / или итерации по строкам.

Обратите внимание, что это не циклически повторяет «все строки в столбце A».Он прекращает цикл, когда в столбце B больше нет значений, которые можно было бы вернуть.

Sub Test2()
    '
    'https://stackoverflow.com/questions/55928149
    '

    Dim i As Long, arr As Variant, bees As Variant

    With Worksheets("original")

        'collect source values
        arr = .Range(.Cells(7, "A"), .Cells(.Rows.Count, "B").End(xlUp)).Value2

        'prepare target array
        ReDim bees(1 To 1, 1 To 1)

        'loop through source value array and retain column B based on condition
        For i = LBound(arr, 1) To UBound(arr, 1)
            'case insensitive comparison
            If LCase(arr(i, 1)) = LCase("Name        ") Then
                'assign column B value to target array
                bees(1, UBound(bees, 2)) = arr(i, 2)
                'make room for next matching value
                ReDim Preserve bees(1 To 1, 1 To UBound(bees, 2) + 1)
            End If
        Next i

        'trim off the last unused element of the target array
        ReDim Preserve bees(1 To 1, 1 To UBound(bees, 2) - 1)

    End With

    'add new worksheet at end of worksheets queue
    With Worksheets.Add(after:=Worksheets(Worksheets.Count))

        'rename new worksheet
        .Name = "bees"

        'put target array in new worksheet starting at A2
        .Cells(2, "A").Resize(UBound(bees, 2), UBound(bees, 1)) = _
            Application.Transpose(bees)

    End With

End Sub

Answer 2

Вы можете просто пройти через диапазон ячеек и использовать смещение, чтобы получить значение в столбце B для размещения на новом рабочем листе. Это не должно быть рекурсивным

Sub Test()
Dim c As Range
Dim iRow As Long
    iRow = 1
    For Each c In Sheets("original").Range("A:A")
    If c.Value = "Name        " Then
        Sheets("new").Cells(iRow, 1).Value = c.Offset(0, 1).Value
        'move to the next row
        iRow = iRow + 1
    End If
    Next c
End Sub