添加到数组并在数组中查找值

Question

我有2个数组：一个数组具有搜索文档的值（arr），另一个数组将使用找到的值（arr2）放入相关的单元格地址。我对arr没有任何问题，并且已在我的代码中成功使用过它。

使用arr2，我想找到包含arr中值的所有单元格，并将单元格地址lRow向下添加到arr2，但只有该地址不在arr2。

为了解决我的问题，我找到了2个我想要结合的答案，但到目前为止没有运气。

Excel VBA - adding an element to the end of an array

How to search for string in an array

我的代码如下：

Sub Initiate()

Dim arr(3) As Variant
    arr(0) = "Value1"
    arr(1) = "Value2"
    arr(2) = "Value3"
    arr(3) = "Value4"
Dim arr2() As Variant
Dim Alc as String
Dim lRow as Long
Dim fVal as String

lRow = Activesheet.Cells(Activesheet.Rows.Count, 1).End(xlUp).Row

For Each element In arr

fVal = element

Set fRange = WA.Cells.Find(What:=fVal, LookIn:=xlFormulas _
    , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

While Not fRange Is Nothing

    While Not IsInArray(fRange.Offset(lRow - 6, 0).Address(False, False), arr2)

        ReDim Preserve arr2(0 To UBound(arr2) + 1) As Variant

        arr2(UBound(arr2)) = fRange.Offset(lRow - 6, 0).Address(False, False)

    Set fRange = WA.Cells.Find(What:=fVal, LookIn:=xlFormulas _
    , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False)

    Wend

Wend

Next element

Alc = "="

    For Each element In arr2

        Alc = Alc & element & "+"

    Next element

Alc = Left(Alc, Len(Alc) - 1)

MsgBox Alc

End Sub

Function IsInArray(stringToBeFound As String, arr2 As Variant) As Boolean

    IsInArray = (UBound(Filter(arr2, stringToBeFound)) > -1)

End Function

运行时出现以下错误：

在这行代码上（在IsInArray函数内）：

IsInArray = (UBound(Filter(arr2, stringToBeFound)) > -1)

非常感谢任何帮助！

Answer 1

我不喜欢使用过滤器，因为它也匹配子串，而且通常不是你想要的

Function IsInArray(stringToBeFound As String, arr2 As Variant) As Boolean

    IsInArray = Not IsError(Application.Match(stringToBeFound, arr2, 0))

End Function

此外：

ReDim Preserve arr2(0 To UBound(arr2) + 1) As Variant

应该是：

ReDim Preserve arr2(0 To UBound(arr2) + 1)

Answer 2

我想我在这里添加评论作为答案。 （我希望它不在本问题/论坛的范围之外）。如果您希望在集合中存储唯一值，我不确定您是否可以超越字典的性能。

在循环之外，您将声明并实例化Dictionary：

Dim oDict as Object
Set oDict = CreateObject("Scripting.Dictionary")

您当前用于搜索arr2的代码，然后添加值，如果将修改为unique，则会显示如下内容：

If Not oDict.Exists(fRange.Offset(lRow - 6), 0).Address(False, False)) then
    oDict(fRange.Offset(lRow - 6), 0).Address(False, False)) = ""
End If

Set fRange = WA.Cells.Find(What:=fVal, LookIn:=xlFormulas _
, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)

我不知道您希望插入或搜索的记录数量，或者您的软件需要的性能如何，但性能可能会有很大差异。