Suppression des doublons

Bonjour,

Je suis nouveau sur le forum et j'aurais besoin de votre aide….

Dans l'exemple ci-dessous j'aimerais que pour chaque numéro, ma macro supprime les lignes pour lesquels les comptes sont en doublons.

J'ai essayé en faisant une compilation de boucles while, for ; deux boucles for mais rien ne foncionne. Elle me supprime les mauvais compte à chaque fois. J'ai également essayé une boucle do until mais la ça me met carrément erreur de capacité… Je ne sais plus quoi faire.

Il faudrait que pour chaque numéro, pour chaque compte, elle regarde si le compte est en double. Si elle a deux fois le même compte, elle supprime la ligne où il n'y a pas de compte auxiliaire.

Si quelqu'un a des conseils ou une idée, je vous en serai très reconnaissant !!

Salut Antoine, Bienvenue sur ce Fofo

Voici ci-dessous un code a tester avec ton fichier :

Sub SuppDoublon()
Dim x As Long
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
    For y = x + 1 To Range("A" & Rows.Count).End(xlUp).Row
        If Cells(y, 5) & Cells(y, 6) & Cells(y, 12) & Cells(y, 13) = Cells(x, 5) & Cells(x, 6) & Cells(x, 12) & Cells(x, 13) Then
            If Cells(x, 7) = "" Then
                Rows(x).Delete shift:=xlUp
            Else
                Rows(y).Delete shift:=xlUp
            End If
            x = x - 1
            Exit For
        End If
    Next
    If Cells(x, 1) = "" Then Exit For
Next
End Sub

En gros sa compare le "CompteNum" ; le "CompteLib" ; le Débit et le Crédit d'une ligne x et d'une ligne y.

Si les deux sont identiques, alors la macro supprime la ligne n'ayant pas de compte auxi

Restant à ta dispo si sa ne conviens pas

Juice t'es mon sauveur !!

Merci mille fois

Juice a écrit :

Salut Antoine, Bienvenue sur ce Fofo

Voici ci-dessous un code a tester avec ton fichier :

Sub SuppDoublon()
Dim x As Long
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
    For y = x + 1 To Range("A" & Rows.Count).End(xlUp).Row
        If Cells(y, 5) & Cells(y, 6) & Cells(y, 12) & Cells(y, 13) = Cells(x, 5) & Cells(x, 6) & Cells(x, 12) & Cells(x, 13) Then
            If Cells(x, 7) = "" Then
                Rows(x).Delete shift:=xlUp
            Else
                Rows(y).Delete shift:=xlUp
            End If
            x = x - 1
            Exit For
        End If
    Next
    If Cells(x, 1) = "" Then Exit For
Next
End Sub

En gros sa compare le "CompteNum" ; le "CompteLib" ; le Débit et le Crédit d'une ligne x et d'une ligne y.

Si les deux sont identiques, alors la macro supprime la ligne n'ayant pas de compte auxi

Restant à ta dispo si sa ne conviens pas

Juice, comment est ce que je peut intégrer une condition supplémentaire à ton programme ?

En fait il faudrait que ton programme se fasse pour chaque n° d'écriture (colonne A). Or, d'état actuel des choses, ton programme compare chaque ligne à l'ensemble des lignes du fichier….

Si on rajoute If Cells(y, 1) & Cells(y, 5)…. Le fichier va à nouveau comparer ligne par ligne avec l'ensemble des lignes du fichier.

Comment je peux faire pour dire à ma macro :

- Pour chaque n° d'écriture, tu exécutes ton programme.

J'ai pensé à mettre en place un compteur pour que la macro compte le nombre de lignes dans une écriture et qu'elle analyse jusqu'à la dernière ligne de l'écriture mais ça ne fonctionne pas.

Par exemple :

Do while Cells(x, 3) <> ""

t = 1

Do While Cells(x, 3) = Cells (x + t, 3)

t = t + 1

Loop

For x = 2 to t

… (ton programme)

x = x + t

Loop

End Sub

Re- Antoine,

Normalement, le rajout d'une condition dans le If aurait suffit :p

Mais voici un code qui te permet de procéder uniquement si le "JournalCode" est identique :

Sub b()
Dim x As Long, y As Long
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
    y = x + 1
    While Cells(y, 1) = Cells(x, 1)
       'ICI TU MET LE CODE QUI TE CONVIENS
        y = y + 1
    Wend
    x = y - 1
Next
End Sub

Restant à ta dispo!

Juice,

J'ai intégré ton programme à la solution que tu m'as proposées. Il supprime bien la première ligne mais ça ne boucle pas

Il supprime la première ligne puis s'arrête…

Re- Antoine,

Quelle est le problème en faite en rajoutant une condition SI plutôt que d'essayer de catégoriser les "Code Journal" ?

Le fichier que je t'ai envoyé fait que quelques lignes, c'était pour montrer un exemple. Notre fichier de base fait 18 000 lignes…

Du coup si on rajoute une condition si, ton programme va comparer une ligne avec l'ensemble des lignes du fichier et ainsi de suite… ça va prendre des plombes

En lui disant de comparer les lignes au sein d'une écriture, ça réduit le nombre d'opérations.

Aaa~aaah tu veux économiser du temps de traitement!

Bon bah voilà ci-dessous ton code modifié pour qu'il sois plus rapide :

Sub SuppDoublon()
Dim x As Long
For x = 2 To Range("A" & Rows.Count).End(xlUp).Row
    If Cells(x, 1) = Cells(x + 1, 1) Then
        For y = x + 1 To Range("A" & Rows.Count).End(xlUp).Row
            If Cells(y, 1) <> Cells(x, 1) Then Exit For
            If Cells(y, 5) & Cells(y, 6) & Cells(y, 12) & Cells(y, 13) = Cells(x, 5) & Cells(x, 6) & Cells(x, 12) & Cells(x, 13) Then
                If Cells(x, 7) = "" Then
                    Rows(x).ClearContents
                Else
                    Rows(y).ClearContents
                End If
                x = y
                Exit For
            End If
        Next
    End If
    If Cells(x, 1) = "" Then Exit For
Next
Columns("A:P").Select
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Feuil1").Sort.SetRange Range("A2:P" & Range("A" & Rows.Count).End(xlUp).Row)
ActiveWorkbook.Worksheets("Feuil1").Sort.Apply
End Sub

Restant à ta dispo