vba - "Object Required"集合错误

Question

我的 VBA 代码有问题，我尝试在累积 B 和 C 列的值的同时消除报销列表的重复项，但这是有条件的，我的意思是消除重复项是强制性的A列和H列与重复行的值A和H相同，因此需要有两个条件才能删除重复项，谢谢您的帮助
这是我之前构建的代码，但它给了我“需要对象”错误

excel table of the vba code

Sub Bouton1_Cliquer()
Dim Cel As Range
Dim Cel1 As Range
Dim Plage As Range
Dim Plage1 As Range
Dim Col As New Collection
Dim col1 As New Collection
Dim Cumul As Double
Dim Cumul1 As Double
Dim DerLig As Long, i As Long, j As Long, MémoL As Long, p As Long
Dim PremL As Boolean
Dim CodeADELI As String

Application.ScreenUpdating = False
Set Col = New Collection
Set col1 = New Collection
On Error Resume Next



With Worksheets("Feuil1") 'Nom de feuille à adapter
    DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
    DerLig1 = .Range("H" & .Rows.Count).End(xlUp).Row
    'Les Codes ADELI sont placés dans une collection afin d'obtenir une liste sans doublon
    Set Plage = .Range("A2:A" & DerLig)
    Set Plage1 = .Range("H2:H" & DerLig1)

    For Each Cel In Plage
    If Cel <> "" Then Col.Add Cel, CStr(Cel)
    Next Cel

    For Each Cel1 In Plage1
    If Cel1 <> "" Then col1.Add Cel1, CStr(Cel1)
    Next Cel1

    On Error GoTo 0

    'On boucle sur chaque élément de la collection que l'on compare aux codes de la liste.
    For i = 1 To Col.Count
        For p = 1 To col1.Count

    Cumul1 = 0
    Cumul = 0 'Initialisation du total
    MémoL = 0
    PremL = True

        CodeADELI = Col(i)
        INSEE = col1(p)

        'chaque élément de la collection est comparé aux codes de la liste.
        For j = DerLig To 2 Step -1

            If .Range("A" & j).Value = CodeADELI And .Range("H" & j).Value = INSEE Then
                'On ajoute le montant au cumul
                    Cumul = Cumul + .Range("B" & j).Value
                    Cumul1 = Cumul1 + .Range("C" & j).Value
                    'S'il s'agit de la première ligne , on mémorise le numéro de ligne
                    If PremL Then
                        MémoL = j
                        PremL = False
                    'Sinon, on supprime la ligne (doublon)
                    Else
                        .Rows(j).Delete
                        MémoL = MémoL - 1
                        DerLig = DerLig - 1
                        DerLig1 = DerLig
                End If
            End If

        Next j

        'Le cumul est affecté au montant de la ligne  qui reste
        If MémoL > 0 Then .Range("C" & MémoL) = Cumul1
        If MémoL > 0 Then .Range("B" & MémoL) = Cumul

         Next p
    Next i

    End With
    End Sub

Answer 1

您的问题可以通过更改线路来解决

If Cel <> "" Then Col.Add Cel, CStr(Cel)

和

If Cel1 <> "" Then col1.Add Cel1, CStr(Cel1)

至

If Cel <> "" Then Col.Add CStr(Cel), CStr(Cel)

和

If Cel1 <> "" Then col1.Add Cstr(Cel1), CStr(Cel1)

该错误是由于稍后在您的代码中使用 col(i) 引起的。和 col1(p) ，该集合引用了一个范围对象，该对象已被 .Rows(j).Delete 的代码行删除。 .

通过将集合更改为单元格的值，而不是单元格本身，它不会因删除行而被破坏。

一个 Dictionary , 或者只是一个动态尺寸的 String数组，可能是跟踪您希望匹配哪些“键”的更好方法。

Sub Bouton1_Cliquer()
    Dim dict As Dictionary
    Dim key As Variant
    Dim Cumul As Double
    Dim Cumul1 As Double
    Dim DerLig As Long, i As Long, j As Long, MémoL As Long
    Dim PremL As Boolean

    Application.ScreenUpdating = False
    Set dict = New Dictionary

    With Worksheets("Feuil1") 'Nom de feuille à adapter
        DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
        For i = 2 To DerLig
            If Not dict.Exists(.Cells(i, "A") & "|" & .Cells(i, "H")) Then
                dict.Add .Cells(i, "A") & "|" & .Cells(i, "H"), .Cells(i, "A") & "|" & .Cells(i, "H")
            End If
        Next

        For Each key In dict.Keys

            Cumul1 = 0
            Cumul = 0 'Initialisation du total
            MémoL = 0
            PremL = True

            'chaque élément de la collection est comparé aux codes de la liste.
            For j = DerLig To 2 Step -1

                If key = .Cells(j, "A").Value & "|" & .Cells(j, "H").Value Then
                    'On ajoute le montant au cumul
                    Cumul = Cumul + .Range("B" & j).Value
                    Cumul1 = Cumul1 + .Range("C" & j).Value
                    'S'il s'agit de la première ligne , on mémorise le numéro de ligne
                    If PremL Then
                        MémoL = j
                        PremL = False
                    'Sinon, on supprime la ligne (doublon)
                    Else
                        .Rows(j).Delete
                        MémoL = MémoL - 1
                        DerLig = DerLig - 1
                    End If
                End If

            Next j

            'Le cumul est affecté au montant de la ligne  qui reste
            If MémoL > 0 Then .Range("C" & MémoL) = Cumul1
            If MémoL > 0 Then .Range("B" & MémoL) = Cumul

        Next

    End With
End Sub

注意:我不确定您的任何原始代码注释是否仍然有意义 - 我没有尝试翻译它们以查看它们在说什么。