macro suppression de doublon avec condition

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

Voilà j'ai un petit problème, je souhaite supprimer les doublons de ma colonne B et C mais selon le mois de la colonne A.
C'est à dire s'il y a des doublons au cours du mois de janvier (renseigné en colonne A) alors tu me supprimes les doublons et écrit 0 dans la cellule.
Et effectuer la suppression des doublons pour tous les mois.

J'avais réussit à écrire un code mais celui-ci supprime tous les doublons de la colonne sans prendre en compte ma condition du mois.

Merci par avance pour votre aide forum.

Je vous joint le code que j'utilise actuellement, mais celui ci efface les doublons dans toute ma plage.
Je n'arrive pas à intégrer ma condition de départ qui est d'effacer les doublons selon la colonne A, c'est à dire d'effacer tous les doublons dans ma plage si colonne A = janvier ou fevrier ......

Merci pour vos réponse
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 Sub supprimeDoublons() Dim Dico As Object Dim Plage As Range Dim Cel As Range Dim I As Integer 'création du dictionnaire Set Dico = CreateObject("Scripting.Dictionary") 'sélection de la cellule par clic dans la feuille On Error Resume Next Set Cel = Application.InputBox("Veuillez saisir l'adresse de la 1ere cellule à comparer", , , , , , , 8) 'si pas de sélection If Err.Number <> 0 Then MsgBox "Vous devez sélectionner une cellule !" Exit Sub End If 'si plus d'une cellule If Cel.Count > 1 Then MsgBox "Seulement une cellule !" Exit Sub End If 'défini la plage With ActiveSheet Set Plage = Range("B2: C7") 'Cel.CurrentRegion End With 'recherche les doublons For I = 1 To Plage.Count If Dico.Exists(Plage(I).Value) = False Then Dico.Add Plage(I).Value, Plage(I).Value Else Plage(I) = 0 'si doublon 0 dans la cellule End If Next I End Sub

Proposition

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Test()
Dim Plage As Range, c As Range
Dim i As Byte
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")                        ' à adapter selon le nom de ta feuille
    Set Plage = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    For i = 1 To 2
        For Each c In Plage
            If c.Value <> 0 Then
                If Evaluate("=SUMPRODUCT((" & Plage.Address & "=" & c.Address & ")*(" & Plage.Offset(0, i).Address & "=" & c.Offset(0, i).Address & "))") > 1 Then c.Offset(0, i) = 0
            End If
        Next c
    Next i
    Set Plage = Nothing
End With
End Sub

01/03/2012, 15h45
sims92.66

Merci mercatog pour ton code il marche très bien.
Cependant je ne comprend vraiment pas ton codage, pour l'adapter le cas échéant.
Pourrais tu me donner des explications?

Merci encore

D'abord, mets cette formule sur ton fichier en D2 et tire la vers le bas
Tu auras les doublons en D (si la valeur est >1).
Ceci étant testé, c'était simplement pour comprendre la logique du code et pour illustration.

Maintenant, ci-après le code commenté (mais je ne sais pas si c'est compréhensible ou non) Remarque que j'ai corrigé un petite coquille

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
Sub Test()
Dim Plage As Range, c As Range
Dim i As Byte
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")                        ' à adapter selon le nom de ta feuille
    'Plage c'est la plage de données de la colonne A ( à partir de la 2ème ligne)
    Set Plage = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    'On fait une boucle sur les colonnes 1 et 2 à droite de la colonne A (càd B et C)
    For i = 1 To 2
        'pour chaque cellule de plage (càd colonne A)
        For Each c In Plage
            'si la cellule à droite (pour i=1 on a B et pour i=0 on a C) est différente de 0
            If c.Offset(0, i).Value <> 0 Then '<<< coquille était ici
                'Ici on évalue la formule (pour chaque ligne) =SOMMEPROD((A2:A14=Ai)*(B2:B14=Bi)) i=2 à 14 pour ton exemple
                'Cette formule permet de trouver le nombre d'occurences qui répndent au 2 critères suivants:
                'les cellules de la colonne A qui sont égales à Ai
                'ET
                'les cellules de la colonne B (ou C) qui sont égales à Bi (ou Ci)
                'Si on trouve plus d'une occurence, càd il y a doublon, donc on écrir dans Bi 0 (ou Ci)
                If Evaluate("=SUMPRODUCT((" & Plage.Address & "=" & c.Address & ")*(" & Plage.Offset(0, i).Address & "=" & c.Offset(0, i).Address & "))") > 1 Then c.Offset(0, i) = 0
            End If
        Next c
    Next i
    Set Plage = Nothing
End With
End Sub

01/03/2012, 16h18
sims92.66

Merci je comprend un peu mieux maintenant :ccool:

Ton code est vraiment d'une efficacité max

Merci encore