Reputation: 33
I have a problem with my VBA code, I try to eliminate the duplicates of a list of reimbursement while accumulating the values of columns B and C, but this is with conditions, i mean to eliminate a duplicate it is obligatory that the values of the columns A and H are identical to the values A and H of the duplicate line so it is necessary to have the two conditions to remove a duplicate, thank you for your help this is the code I have previously built but it gives me "object required" error
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
Upvotes: 2
Views: 1762
Reputation: 14383
Your use of Col
is conceptually wrong.
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
As you see, with a different concept you need much less code. Or, in reverse order, the concept to which the use of Col
led you required more effort than would otherwise have been needed.
Upvotes: -1
Reputation: 23974
Your problem can be fixed by changing the lines
If Cel <> "" Then Col.Add Cel, CStr(Cel)
and
If Cel1 <> "" Then col1.Add Cel1, CStr(Cel1)
to
If Cel <> "" Then Col.Add CStr(Cel), CStr(Cel)
and
If Cel1 <> "" Then col1.Add Cstr(Cel1), CStr(Cel1)
The error is caused by the fact that later in your code, where you are using col(i)
and col1(p)
, the collection was referring to a range object which had been deleted by the line of code saying .Rows(j).Delete
.
By changing the collection to be just the value of the cell, rather than the cell itself, it won't be destroyed by the deletion of the row.
A Dictionary
, or simply a dynamically dimensioned String
array, may be a better way of keeping track of which "keys" you wish to match on.
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
Note: I'm not sure whether any of your original code comments still make sense - I didn't try to translate them to see what they were saying.
Upvotes: 2