Question

我已经创建了一个数据集合，并且正在尝试使用它，并在必要时删除项目。下面是我的代码，请告知是否可以同时遍历同一集合多次。

我将第一项保存到变量中，以便在搜索集合时用作参考。如果存在匹配项，则计数器增加，当计数器为2或更高时，我便搜索该集合以从整个集合中删除相同的项目。我认为我编写代码的方式可以自我解释，以达到我的目标。如果项目在集合中存在多次，则需要将其删除。

我在设置位置出现运行时错误“ 9”：

<span th:if="${message} != null or ${message} !=  '' ">
  <span th:text= "${message}"></span>
</span>

我不确定为什么会这样，因此任何指导/帮助都值得赞赏！

tempStorageB = EScoll(j)

Answer 1

这是一种解决方案，将从Collection中删除重复项。

由于搜索的迭代性质，您必须一次搜索并删除一个。尽管这效率很低，但是Collection对象并不能使其对这些操作有效。

Option Explicit

Sub test()
    Dim i As Long, j As Long, k As Long

    Dim EScoll As New Collection
    PopulateCollection EScoll

    Dim duplicatesFound As Boolean
    Do
        duplicatesFound = False
        Dim checkItem As Long
        For checkItem = 1 To EScoll.Count
            Dim dupIndex As Long
            dupIndex = DuplicateItemExists(EScoll, EScoll.Item(checkItem))
            If dupIndex > 0 Then
                duplicatesFound = True
                EScoll.Remove (dupIndex)
                '--- kick out of this loop and start again
                Exit For
            End If
        Next checkItem
    Loop Until Not duplicatesFound
    Debug.Print "dupes removed, count = " & EScoll.Count
End Sub

Function DuplicateItemExists(ByRef thisCollection As Collection, _
                             ByVal thisValue As Variant) As Long
    '--- checks to see if two items have the same given value
    '    RETURNS the duplicate index number
    Dim valueCount As Long
    valueCount = 0
    Dim i As Long
    DuplicateItemExists = 0
    For i = 1 To thisCollection.Count
        If thisCollection.Item(i) = thisValue Then
            valueCount = valueCount + 1
            If valueCount > 1 Then
                DuplicateItemExists = i
                Exit Function
            End If
        End If
    Next i
End Function

Sub PopulateCollection(ByRef thisCollection As Collection)
    Const MAX_ITEMS As Long = 50
    Dim i As Long
    For i = 1 To MAX_ITEMS
        thisCollection.Add CLng(Rnd(10) * 10)
    Next i
End Sub

Answer 2

仅显示解决方案（以供有类似问题的任何人将来参考），我对初始错误的原因有了新的认识。问题在于，一旦将for循环的计数设置为集合的计数，在删除项目后它就不会更改。对我来说，一种简单有效的解决方案是以与上述类似的方式循环遍历，而不是使用.Remove，我为新集合添加了所有唯一值。见下文：

Dim SPcoll As New Collection

For i = 1 To EScoll.Count
    tempStorageA = EScoll(i)
    counter = 0
    For j = 1 To EScoll.Count
        tempStorageB = EScoll(j)

        If tempStorageB = tempStorageA Then
            counter = counter + 1
        End If

    Next j

    If counter < 2 Then

    SPcoll.Add tempStorageA

    End If
Next i

SPcoll现在包含以前收藏中的所有独特物品！

Answer 3

您的填充项位于同一子目录中，我会在此期间（紧接之后）删除您的重复项添加）

Sub tsttt()

Dim EScoll As New Collection
Dim DoublesColl As New Collection
Dim x

With EScoll
    For Each x In Range("a1:a10").Value 'adjust to your data
        On Error Resume Next
        .Add x, Format(x)
        If Err.Number <> 0 Then
            DoublesColl.Add x, Format(x)
            On Error GoTo 0
        End If
    Next
    For Each x In DoublesColl
        .Remove Format(x)
    Next
 End With

End Sub

嵌套For Loop处理VBA中的一个集合

3 个答案: