VBA 键已经与集合相关联

Question

我正在使用下面的代码将数据从主“所有数据”表中提取到多个表中，即“设置 ws”。

Sub ForecastExtract()

    Dim ad As Worksheet
    Dim AFTE As Single
    Dim BlnProjExists As Boolean
    Dim bottomB As Integer
    Dim ColDates As New Collection
    Dim Flex As String
    Dim i As Long
    Dim j As Long
    Dim JRole As String
    Dim LastRow As Long
    Dim m As Long
    Dim OVH As Worksheet
    Dim PDate As Date
    Dim PLOB As String
    Dim Portfolio As String
    Dim PRO As Worksheet
    Dim Project As String
    Dim RLOB As String
    Dim rng As Range
    Dim RngDates As Range
    Dim Task As String
    Dim ws As Worksheet

    Application.ScreenUpdating = False

    Const StartRow As Long = 8

    Set ad = Sheets("All Data")

    bottomB = ad.Range("B" & Rows.Count).End(xlUp).Row

    For Each rng In ad.Range("B8:B" & bottomB)

        Set ws = Sheets(rng.Value)

    For i = 3 To ws.Cells(StartRow - 1, Columns.Count).End(xlToLeft).Column
        m = m + 1
        ColDates.Add m, ws.Cells(StartRow - 1, i).Text
    Next i

    On Error Resume Next
    With Sheets("All Data").Range("I7")
        For i = 1 To .CurrentRegion.Rows.Count - 1
            Portfolio = .Offset(i, -7)
            PLOB = .Offset(i, -6)
            RLOB = .Offset(i, -5)
            JRole = .Offset(i, -2)
            Project = .Offset(i, 0)
            PCode = .Offset(i, 1)
            Task = .Offset(i, 3)
            PDate = .Offset(i, 4)
            FFTE = .Offset(i, 6)
            AFTE = .Offset(i, 8)
            Flex = .Offset(i, 9)

            If Portfolio = ws.Name And InStr(.Offset(i, -2), "Consultancy & Innovation") = 0 And _
            InStr(.Offset(i, 0), "TM - DIR") > 0 And _
            .Offset(i, 4).Value >= Application.Min(ws.Rows(7)) And Flex = "Yes" Then
                Portfolio = .Offset(i, -7)
                Task = .Offset(i, 3)

                With ws.Range("B7")
                    If .CurrentRegion.Rows.Count = 1 Then
                        .Offset(1, 0) = Portfolio
                        j = 1
                    Else
                        BlnProjExists = False
                        For j = 1 To .CurrentRegion.Rows.Count - 1
                            If .Offset(j, 0) = Portfolio Then
                                BlnProjExists = True
                                Exit For
                            End If
                        Next j
                        If BlnProjExists = False Then
                            .Offset(j, 0) = Portfolio
                        End If

                        On Error Resume Next
                    m = ColDates(Format(PDate, "mmm yy"))
                    If Err = 0 Then .Offset(j, m) = .Offset(j, m) + FFTE
                    On Error GoTo 0
                    End If
                End With
            End If
        Next i
        On Error GoTo 0
    End With
    Next rng
    End Sub

问题

当代码移动到第二张表以粘贴提取的数据时，我收到以下错误：

This key is already associated with an element of this collection

Debug 突出显示以下行作为原因：

ColDates.Add m, ws.Cells(StartRow - 1, i).Text

我浏览过互联网，类似帖子的一些解决方案建议添加 On error Resume Next... 语句，而其他没有，所以我不确定采用哪种方法。

Answer 1

集合不同于字典。无论如何查看您的代码，我认为使用字典就足够了。

无论如何，为了在您的代码中收集，您需要在您的关键部分添加一些东西以使其独一无二。

在ColDates.Add m, ws.Cells(StartRow - 1, i).Text 中，密钥是ws.Cells(StartRow - 1, i).Text。现在在第二张表中，您的数据必须重复，因此存在问题。

一种可能的解决方案是在键中添加计数器：

ColDates.Add m, ws.Cells(StartRow - 1, i).Text & CStr(m)