Question

我的VBA代码有问题，我试图在累积B和C列的值时消除补偿清单的重复，但这是有条件的，我的意思是消除重复它必须是列A和H的值与重复行的值A和H相同，因此必须有两个条件才能删除重复项，谢谢您的帮助这是我之前构建的代码，但它给了我＆＃34;对象需要＆＃34;错误

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数组，可能是更好地跟踪哪些＆＃34;键＆＃34;你希望匹配。

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

注意：我不确定您的原始代码评论是否仍然有意义 - 我没有尝试翻译它们以查看他们所说的内容。

Answer 2

您对Col的使用在概念上是错误的。

Sub Bouton1_Cliquer()
    ' 28 Sep 2017

    Dim Rng As Range
    Dim Rl As Long

    With Worksheets("Feuil1")
        Rl = .Cells(.Rows.Count, "A").End(xlUp).Row
        ' columns 1 = A, 8 = H
        .Range(.Cells(2, "A"), .Cells(Rl, .UsedRange.Columns.Count)) _
               .RemoveDuplicates Columns:=Array(1, 8), Header:=xlNo
        Set Rng = .Range(.Cells(2, "B"), .Cells(Rl, "B"))

        Rl = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
        .Cells(Rl, "B").Value = Application.Sum(Rng)
        Rl = .Cells(.Rows.Count, "C").End(xlUp).Row + 1
        .Cells(Rl, "C").Value = Application.Sum(Rng.Offset(0, 1))
    End With
End Sub

如您所见，使用不同的概念，您需要更少的代码。或者，以相反的顺序，使用Col引导您的概念需要比本来需要的更多努力。

＆＃34;对象要求＆＃34;收藏错误

2 个答案: