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

【问题标题】：Adding to arrays and finding values in arrays添加到数组并在数组中查找值
【发布时间】：2016-06-22 19:38:30
【问题描述】：

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

使用arr2，我想找到包含arr 中的值的任何单元格，并将单元格地址lRow 从它向下添加到arr2，但前提是该地址不是已经在arr2。

我找到了 2 个 SO 答案，我正在尝试结合这些答案来解决我的问题，但到目前为止还没有运气。

Excel VBA - adding an element to the end of 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)

非常感谢任何帮助！

【问题讨论】：

你有没有考虑用字典来代替arr2。如果将唯一值存储为键，则可以相对轻松地防止重复。

标签： excel vba

【解决方案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)

【讨论】：

【解决方案2】：

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

在循环之外，您可以声明并实例化 Dictionary:

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

您当前用于搜索 arr2 然后添加值（如果唯一）的代码将被修改为如下所示：

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)

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

【讨论】：