FindNext - проверка кода VBA верна, но в Excel не работает [дубликат]

Причина, по которой она дает только первое совпадение, связана с ошибкой. См. Ссылку (РАЗДЕЛ 5) внизу.

Я уже давно подал ее как ошибку. Если вы прочитали вышеприведенную ссылку, я также предложил альтернативный код.

Извлеките эту ссылку в случае, если ссылка когда-либо замирает (что ей не нужно)

.FindNext doesn работайте в пользовательской функции, как ожидалось. Вы можете использовать его в нормальной функции.

Позволяет сказать, что у нас есть эти данные в Sheet1:

A1 → Colt
A2 → Holt
A3 → Dolt
A4 → Hello

и в

B1 → olt

Теперь, если мы вставьте приведенный ниже код в модуль и запустите его, тогда мы получим ожидаемый результат как $A$1:$A$3

Sub Test()
    Sample Sheets("Sheet1").Range("B1"), Sheets("Sheet1").Range("A1:A4")
End Sub

Sub Sample(FirstRange As Range, ListRange As Range)
    Dim aCell As Range, bCell As Range, oRange As Range
    Dim ExitLoop As Boolean
    Set oRange = ListRange.Find(what:=FirstRange.Value, LookIn:=xlValues, _
    lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    ExitLoop = False
    If Not oRange Is Nothing Then
        Set bCell = oRange: Set aCell = oRange

        Do While ExitLoop = False
            Set oRange = ListRange.FindNext(After:=oRange)

            If Not oRange Is Nothing Then
                If oRange.Address = bCell.Address Then Exit Do
                Set aCell = Union(aCell, oRange)
            Else
                ExitLoop = True
            End If
        Loop
        MsgBox aCell.Address
    Else
        MsgBox "Not Found"
    End If
End Sub

Однако он не будет работать так, как ожидалось, если вы вставляете эту функцию в модуль и вызываете ее из рабочий лист как (Say in Cell C1) =FindRange(A1,A1:A5)

Код даст вам только 1-й экземпляр найденного значения и игнорирует остальные

. И, следовательно, результат, который вы будете get $ A $ 2 !!!

Function FindRange(FirstRange As Range, ListRange As Range) As String
    Dim aCell As Range, bCell As Range, oRange As Range
    Dim ExitLoop As Boolean
    Set oRange = ListRange.Find(what:=FirstRange.Value, LookIn:=xlValues, _
    lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    ExitLoop = False
    If Not oRange Is Nothing Then
        Set bCell = oRange: Set aCell = oRange

        Do While ExitLoop = False
            Set oRange = ListRange.FindNext(After:=oRange)

            If Not oRange Is Nothing Then
                If oRange.Address = bCell.Address Then Exit Do
                Set aCell = Union(aCell, oRange)
            Else
                ExitLoop = True
            End If
        Loop
        FindRange = aCell.Address
    Else
        FindRange = "Not Found"
    End If
End Function

Нам нужно подходить к этому под другим углом.

Вместо использования .FindNext мы используем .Find снова, пока не получим желаемый результат ($ A $ 1: $ A $ 3). См. Код ниже, который работает:

Function FindRange(FirstRange As Range, ListRange As Range) As String
    Dim aCell As Range, bCell As Range, oRange As Range
    Dim ExitLoop As Boolean
    Set oRange = ListRange.Find(what:=FirstRange.Value, LookIn:=xlValues, _
    lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)
    ExitLoop = False
    If Not oRange Is Nothing Then
        Set bCell = oRange: Set aCell = oRange

        Do While ExitLoop = False
            Set oRange = ListRange.Find(what:=FirstRange.Value, After:=oRange, LookIn:=xlValues, _
            lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
            If Not oRange Is Nothing Then
                If oRange.Address = bCell.Address Then Exit Do
                Set aCell = Union(aCell, oRange)
            Else
                ExitLoop = True
            End If
        Loop
        FindRange = aCell.Address
    Else
        FindRange = "Not Found"
    End If
End Function