有时不能分配给数组，有时可以

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

以下对我有用。

在这段代码中，每个对象变量都被显式地分配了一个类型。在 VBA 中，每个 变量都必须输入类型，否则默认分配类型为 Variant。例如，在下面的声明行中，foundRanges() 的类型为 Variant，因为它后面没有带有数据类型的 As。与问题下一行代码中的i 相同。

Dim foundRanges(), rngSearch As Range

由于调用过程中的数组是Range 类型，因此函数应该返回相同的类型。

我还冒昧地将Document 对象传递给函数，因为可以想象，有一天，有问题的文档可能不是ActiveDocument，而是使用Documents.Open 或Documents.Add 分配的Document 对象。如果不需要，可以改回来，但不依赖ActiveDocument 更可靠...

此外，我在Find.Execute 中添加了Wrap 参数 - 在循环中执行 Find 时指定它总是一个好主意，以防止在文档开头重新开始搜索 (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

Answer 2

这是一个基于集合而不是数组的替代方案：
我还使用了包含 Cindys Input 的关于传递文档和添加换行的方法。
我不完全知道您将返回值用于什么，但总的来说，集合比数组更灵活。
我还删除了下划线，因为它们表示已实现接口的功能，可能会在以后引起问题。在实现Interface时使用（提高可读性）。
正如here 解释的那样，您可以使用 wrap 或 collapse 来防止连续循环。

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