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而是使用{{ 1}}或Document。如果不希望这样做，可以将其改回，但不依赖Documents.Open更可靠...

此外，我在Documents.Add中添加了ActiveDocument参数-最好在循环中执行Find时指定，以防止搜索从文档的开头再次开始（wdFindContinue ）。

Wrap

Answer 2

这是基于Collection而不是Array的替代方法：
我还使用了Cindys Input，用于传递文档和添加包装。
我不完全知道您将返回值用于什么目的，但总的来说，集合比数组要灵活一些。
我还删除了下划线，因为它们~~表示已实现接口的功能，并可能在以后产生问题。~~在实现Interface时使用（提高可读性）。
如here所述，您可以使用自动换行或折叠来防止连续循环。

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

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

2 个答案: