Иногда не может назначить массив, а иногда может

Question

У меня есть следующий код:

Function findRanges(keyword) As Variant()

Dim foundRanges(), rngSearch As Range
Dim i, foundCount As Integer

i = 0
foundCount = 0
ReDim foundRanges(0)

Set rngSearch = ActiveDocument.Range
    Do While rngSearch.Find.Execute(FindText:=keyword, MatchWholeWord:=True, Forward:=True) = True
        Set foundRanges(i) = rngSearch.Duplicate
        i = i + 1
        ReDim Preserve foundRanges(UBound(foundRanges) + 1)
        rngSearch.Collapse Direction:=wdCollapseEnd

    Loop

ReDim Preserve foundRanges(UBound(foundRanges) - 1)

findRanges = foundRanges

End Function

И:

Sub test()
Dim rngIAM_Code() As Range
...
Dim rngIAM_Title() As Range

rngIAM_Code = findRanges("IAM_Code")
...
rngIAM_Title = findRanges("IAM_Title")


End Sub

Что очень обидно, так это то, что иногда компилятор говорит «Не удается назначить массив», а иногдаработает отлично.Например, когда я пытаюсь найти только одно значение и заполнить один массив, код работает.Когда я пытаюсь заполнить оба массива, возникает ошибка «Невозможно назначить массив».Затем я могу переключать строки кода следующим образом:

rngIAM_Title = findRanges("IAM_Title")
...
rngIAM_Code = findRanges("IAM_Code")

И тогда ошибка происходит с другим массивом.Ошибка может произойти где угодно: в первой строке, в середине или в конце, но она постоянна, пока я не перемещаю строки.И снова, если я оставлю только одну-две строки кода с массивами в под-тесте, все будет работать нормально.

Answer 1

Вот альтернатива, основанная на коллекции вместо массива:
Я также использовал вход Cindys для передачи документа и добавления переноса.
Я точно не знаю, для чего вы используете возвращаемое значение, но в целом коллекция немного более гибкая, чем массив.
Я также удалил подчеркивания, поскольку они указывают на функцию реализованного интерфейса и могут вызвать проблемы в дальнейшем. используются, когдареализация Interface (улучшает читабельность).
Как объяснено здесь , вы можете использовать перенос или свертывание для предотвращения непрерывного цикла.

Option Explicit

Sub test()
    Dim rngIAMCode As Collection
    Dim rngIAMTitle As Collection

    Set rngIAMCode = findRanges("IAM_Code", ActiveDocument)
    Set rngIAMTitle = findRanges("IAM_Title", ActiveDocument)

    Debug.Print "Code found : " & rngIAMCode.Count & " Times."
    Debug.Print "Title found : " & rngIAMTitle.Count & " Times."

End Sub



Function findRanges(ByVal keyword As String, doc As Document) As Collection

    Set findRanges = New Collection
    Dim rngSearch As Range

    Set rngSearch = doc.Content
    With rngSearch.Find
        .Text = keyword
        .MatchWholeWord = True
        .Forward = True
        .Wrap = wdFindStop

        While .Execute
            findRanges.Add rngSearch.Duplicate
            rngSearch.Collapse Direction:=wdCollapseEnd
        Wend

    End With
End Function

Answer 2

Для меня работает следующее.

В этом коде каждой переменной объекта явно присваивается тип.В VBA каждая переменная должна быть набрана, в противном случае ей присваивается тип Variant по умолчанию.Например, в следующей строке объявления foundRanges() имеет тип Variant, поскольку за ним не следует As с типом данных.То же самое с i в следующей строке кода в вопросе.

Dim foundRanges(), rngSearch As Range

И поскольку массивы в вызывающей процедуре имеют тип Range, функция должна возвращать тот же тип.

Я также взял на себя смелость передать объект Document в функцию, поскольку, возможно, однажды рассматриваемый документ может быть не ActiveDocument, а объектом Document, назначенным с использованием Documents.Open или Documents.Add.Если это нежелательно, его можно изменить обратно, но не полагаться на ActiveDocument более надежно ...

Кроме того, я добавил параметр Wrap в Find.Execute - это всегда хорошая идея дляукажите это при выполнении поиска в цикле, чтобы предотвратить повторный поиск в начале документа (wdFindContinue).

Sub testRangesInArrays()
    Dim rngIAM_Code() As Range
    Dim rngIAM_Title() As Range

    rngIAM_Code = findRanges("You", ActiveDocument)
    rngIAM_Title = findRanges("change", ActiveDocument)
End Sub

Function findRanges(keyword As String, doc As Word.Document) As Range()
    Dim foundRanges() As Range, rngSearch As Range
    Dim i As Integer, foundCount As Integer

    i = 0
    foundCount = 0
    ReDim foundRanges(0)

    Set rngSearch = doc.content
    Do While rngSearch.Find.Execute(findText:=keyword, MatchWholeWord:=True, _
                       Forward:=True, wrap:=wdFindStop) = True
        Set foundRanges(i) = rngSearch.Duplicate
        ReDim Preserve foundRanges(UBound(foundRanges) + 1)
        i = i + 1
        rngSearch.Collapse Direction:=wdCollapseEnd
    Loop

    findRanges = foundRanges

End Function