VBA/MACRO : Regrouper la somme des doublons avec conditions

Bonjour,

Le code suivant utilise une collection qui constitue une liste sans doublon des codes fournisseurs.
Cette collection permet ensuite de faire un balayage de toutes les lignes de la feuille afin d’effectuer le cumul des montants pour chaque fournisseur en laissant de coté les lignes pour lesquelles la date d’échéance n’est pas renseignée. Chaque doublon est alors supprimé.
Au final, il doit te rester pour chaque fournisseur une seule ligne avec l’échéance renseignée (sous réserve qu’il y en ait au moins une) et toutes les autres lignes ayant une échéance non renseignée.

J’ai supposé que la première ligne est une ligne d’en-têtes avec les 4 libellés et que la feuille a le nom Feuil1. A toi d’adapter le code si besoin.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Option Explicit
Sub Test()
Dim Cel As Range, Plage As Range
Dim Col As Collection
Dim Cumul As Double
Dim DerLig As Long, i As Long, j As Long, MémoL As Long
Dim PremL As Boolean
Dim CodeFournisseur As String
 
    Application.ScreenUpdating = False
    Set Col = New Collection
    On Error Resume Next
 
    With Worksheets("Feuil1") 'Nom de feuille à adapter
        DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
 
        'Les Codes fournisseurs sont placés dans une collection afin d'obtenir une liste sans doublon
        Set Plage = .Range("A2:A" & DerLig)
        For Each Cel In Plage
            If Cel <> "" Then Col.Add Cel, CStr(Cel)
        Next Cel
        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
        Cumul = 0 'Initialisation du total
        MémoL = 0
        PremL = True
            CodeFournisseur = Col(i)
            '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 = CodeFournisseur Then
                    'Si la cellule correspondant à la date d'échéance n'est pas vide,
                    If .Range("C" & j).Value <> "" Then
                        'On ajoute le montant au cumul
                        Cumul = Cumul + .Range("D" & j).Value
                        'S'il s'agit de la première ligne fournisseur, 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
                End If
            Next j
            'Le cumul est affecté au montant de la ligne fournisseur qui reste
            If MémoL > 0 Then .Range("D" & MémoL) = Cumul
        Next i
    End With
 
    Set Plage = Nothing
    Set Col = Nothing
    Application.ScreenUpdating = True
End Sub

Cordialement.