Repérer des doublons en VBA

Résolu/Fermé
mcou - 26 juil. 2012 à 14:40
h.bendaoud Messages postés 21 Date d'inscription vendredi 27 mars 2015 Statut Membre Dernière intervention 10 avril 2015 - 30 mars 2015 à 15:29
Bonjour,

Je souhaiterais - sans utiliser la validation des données - vérifier que mes numéros de commande (situés tous en colonne A) sont uniques.
Je sais qu'on peut détecter les doublons avec la formule : NB.SI($A$1:$A$20;A1)>1
Est-il possible de transférer cela en code VBA.

Voilà la code que j'ai commencé à taper :

Sub Macro_Numero_Reference()
Dim cell As Range

Sheets("FOLLOW-UP").Select
    
Range(Range("A4"), Range("A65000").End(xlUp)).Select  'décale la cellule active d'une case sur la droite
For Each cell In selection

If   Then 'je ne sais pas quoi mettre

MsgBox "Erreur de saisie.", vbCritical, "VERIFICATION SAISIE"
cell.Value = UCase(InputBox("Saisir un nouveau numéro de référence :", "NOUVELLE COMMANDE", ""))
Calculate

End If
Next

End Sub


Merci de voter aide par avance. mcou

5 réponses

tuxboy Messages postés 994 Date d'inscription lundi 23 juillet 2012 Statut Membre Dernière intervention 28 mai 2019 188
26 juil. 2012 à 15:16
Tu peux essayer d'adapter cette fonction :


Public Sub Doublons()
Dim Col As Integer
Dim k As Long
Dim C As Range
Dim N As Long
Dim V As Variant
Dim Rng As Range

On Error GoTo FinMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("FOLLOW-UP").Select
Col = ActiveCell.Column
If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If

N = 0
For k = Rng.Rows.Count To 1 Step -1
Rng.Cells(k, 1).Value = RTrim(Rng.Cells(k, 1).Value)
Next r

For k = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(k, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
Rng.Rows(k).EntireRow.Delete
N = N + 1
End If
Next r

FinMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Bon courage !
0
je m'y atèle !
0
pijaku Messages postés 12259 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 9 août 2022 2 708
26 juil. 2012 à 15:53
Attention tout de même!!!!!!

Dans ton code je vois :
Rng.Rows(k).EntireRow.Delete 


Supposes que mcou perde ces données! Tu devrais au moins prévenir...
0
Alors alors, quand je lance la macro telle quelle, cela me dit que la variable r n'est pas définie.
Je ne sais pas comment la définir (range, variant, long...) puisque je ne vois pas à quoi cela correspond.
Par ailleurs, je veux que col soit la colonne A. (de A4 : A5000 pour être précise).
J'ai changé Col = ActiveCell.Column
en Col = Column("A")
mais ça bug...
0
tuxboy Messages postés 994 Date d'inscription lundi 23 juillet 2012 Statut Membre Dernière intervention 28 mai 2019 188
26 juil. 2012 à 15:56
r... à supprimer.
0
heureusement que je ne travaille pas sur mes données mais sur un fichier vierge.
pikaju, aurais-tu une idée à me suggérer ?
0
pijaku Messages postés 12259 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 9 août 2022 2 708
31 juil. 2012 à 09:03
Bonjour,
Il faut que tu testes l'existence ou non dans ton dictionary des éléments que tu souhaites y ajouter :

For Each c In Range("a4", [a65000].End(xlUp))
    If Not mondico.Exists(c.Value) Then 
        mondico(c.Value) = ""
    Else
        MsgBox c.Address
    End If
    Next c
0
Bonjour,
Je ne comprend pas bien ce que votre bout de code réalise exactement. En quoi cela me permet-il de changer uniquement mon doublon sans changer ma première occurence ?
0
pijaku Messages postés 12259 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 9 août 2022 2 708
31 juil. 2012 à 10:45
1- tu parcours ta colonne : For Each c In Range("a4", [a65000].End(xlUp))
2- Si c.Value n'est pas encore enregistré dans mon dictionary (1ère occurence donc) : If Not mondico.Exists(c.Value) Then
3- alors je l'enregistre : mondico(c.Value) = ""
4- par contre, si c.Value est déjà un élément de mon Dictionary (occurences suivantes) : Else
5- Alors je veux connaitre l'adresse de la cellule qui contient donc les occurences suivantes : MsgBox c.Address
0
Rebonjour,

Merci pour vos explications. Hélas, votre bout de code ne m'apporte rien.
Avec le code ci dessous, Comment faire pour que seule ma seconde occurence, lorsqu'un doublon est détecté, chance de numéro de référence ?

Sub Macro_Numero_Reference()

' vérifiation de l'unicité et de la présence obligatoire des numéros de référence pour toutes les commandes qui ont été saisies

    Dim mondico As Object 'déclare mondico comme un object
    [A:A].Interior.ColorIndex = xlNone ' met toutes les cellules de la colonne A sans couleur de fond
    Range("A1:A2").Interior.ColorIndex = 35 'maintient la couleur de fond pour les entêtes
    Set mondico = CreateObject("Scripting.Dictionary") 'associe la variable mondico à un dictionnaire - création d'object
    
    Calculate 'recalcule le document afin que dans la cellule A2 soit mise à jour
    
    For Each cell In Range("A4", [a65000].End(xlUp)) 'pour chaque cellule de la colonne A (sans les entêtes)
        mondico.Item(cell.Value) = mondico.Item(cell.Value) + 1 'il est associé la valeur au mondico
    Next cell
   
    
    For Each cell In Range("A4", [a65000].End(xlUp)) ' pour chaque cellule de la colonne A (sans les entêtes)
        If mondico.Item(cell.Value) > 1 Then 'si la valeur de la cellule apparait plus d'une fois
            Call Rempli_Textbox 'rempli l'adresse et la valeur de la cellule en question dans le formulaire verification_ALL
            cell.Value = InputBox("Un doublon a été détecté. Veuillez changer le numéro de référence.", "NUMERO DE REFERENCE", Range("A2").Value + 1) 'affecte une nouvelle valeur à la cellule doublon à travers une inputbox
        End If
        Calculate 'mise à jour de la cellule A2
    Next cell
        
    For Each cell In Range("A4", [a65000].End(xlUp)) ' pour chaque cellule de la colonne A (sans les entêtes)
        Do While cell.Value = "" 'tant que la cellule est vide
            Call Rempli_Textbox 'rempli l'adresse et la valeur (vide) de la cellule en question dans le formulaire verification_ALL
            cell.Value = InputBox("Numéro de référence inexistant. Veuillez en indiquer un.", "NUMERO DE REFERENCE", Range("A2").Value + 1) 'affecte une valeur à la cellule vide à travers une inputbox
        Loop
        Calculate 'mise à jour de la cellule A2
    Next cell
    
End Sub


Merci d'avance de votre réponse.
0
pijaku Messages postés 12259 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 9 août 2022 2 708
31 juil. 2012 à 16:51
tu n'as pas l'impression d'un tout p'tit peu exagérer???
Je t'ai tout mis au dessus tu n'avais qu'à adapter...
je fais l'effort une dernière fois...

Set mondico = CreateObject("Scripting.Dictionary")

For Each c In Range("a4", [a65000].End(xlUp))
    If Not mondico.Exists(c.Value) Then
        mondico(c.Value) = ""
    Else
'------------ICI TES ACTIONS----------------
    '---------PAR EXEMPLE :
        Set cell = c
        Call Rempli_Textbox
        c.Value = InputBox("Un doublon a été détecté. Veuillez changer le numéro de référence.", "NUMERO DE REFERENCE", Range("A2").Value + 1)
    End If
Next c
0
Bonjour,

Merci de votre aide. Je n'avais pas compris tout et pensais que l'initial code que vous m'aviez fournie était à rajouter en plus du mien.
Je n'ai pas eu le temps hier en plus de mettre le nez dans ce problème. Maintenant il est résolu et je vous en remercie.

Je joins mon code final :

Sub Macro_Numero_Reference()

' vérifiation de l'unicité et de la présence obligatoire des numéros de référence pour toutes les commandes qui ont été saisies

    Dim mondico As Object 'déclare mondico comme un object
    [A:A].Interior.ColorIndex = xlNone ' met toutes les cellules de la colonne A sans couleur de fond
    Range("A1:A2").Interior.ColorIndex = 35 'maintient la couleur de fond pour les entêtes
    Set mondico = CreateObject("Scripting.Dictionary") 'associe la variable mondico à un dictionnaire - création d'object
    
    Calculate 'recalcule le document afin que dans la cellule A2 soit mise à jour
    
    For Each cell In Range("A4", [a65000].End(xlUp)) 'pour chaque cellule de la colonne A (sans les entêtes)
        If Not mondico.exists(cell.Value) Then
            mondico(cell.Value) = ""
        Else
            Call Rempli_Textbox 'rempli l'adresse et la valeur de la cellule en question dans le formulaire verification_ALL
            cell.Value = InputBox("Un doublon a été détecté. Veuillez changer le numéro de référence.", "NUMERO DE REFERENCE", Range("A2").Value + 1) 'affecte une nouvelle valeur à la cellule doublon à travers une inputbox
        End If
        Calculate 'mise à jour de la cellule A2
    Next cell
    
    For Each cell In Range("A4", [a65000].End(xlUp)) ' pour chaque cellule de la colonne A (sans les entêtes)
        Do While cell.Value = "" 'tant que la cellule est vide
            Call Rempli_Textbox 'rempli l'adresse et la valeur (vide) de la cellule en question dans le formulaire verification_ALL
            cell.Value = InputBox("Numéro de référence inexistant. Veuillez en indiquer un.", "NUMERO DE REFERENCE", Range("A2").Value + 1) 'affecte une valeur à la cellule vide à travers une inputbox
        Loop
        Calculate 'mise à jour de la cellule A2
    Next cell
    
End Sub
0
pijaku Messages postés 12259 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 9 août 2022 2 708
Modifié par pijaku le 1/08/2012 à 09:01
Bonjour,

Une incohérence apparait dans la dernière partie de ton code.
Tu boucles sur toutes les lignes colonne A :
For Each cell In Range("A4", [a65000].End(xlUp)) ' pour chaque cellule de la colonne A (sans les entêtes)
Puis tu boucles à nouveau sur toutes les cellules vides :
 Do While cell.Value = "" 'tant que la cellule est vide

Un simple test suffit ici :
If cell.Value ="" Then

De plus, supposons que les dernières lignes de la colonne A ne soient pas remplies.... Elles ne seront pas traités car tu calcules la dernière ligne remplie colonne A... Il faut, pour déterminer la dernière ligne à traiter, prendre la colonne qui sera effectivement et systématiquement la plus "longue".
Exemple avec la colonne B :
Dim DrLig As Long 

DrLig = Range("B" & Rows.Count).End(xlUp).Row 
For Each cell In Range("A4:A" & DrLig) ' pour chaque cellule de la colonne A (sans les entêtes) 
        If cell.Value = "" 'tant que la cellule est vide 
            Call Rempli_Textbox 'rempli l'adresse et la valeur (vide) de la cellule en question dans le formulaire verification_ALL 
            cell.Value = InputBox("Numéro de référence inexistant. Veuillez en indiquer un.", "NUMERO DE REFERENCE", Range("A2").Value + 1) 'affecte une valeur à la cellule vide à travers une inputbox 
        End If 
Next cell


Après, pour parfaire le code, tu peux aussi empêcher la saisie de n'importe quoi dans l'Inputbox. En supposant, ici, que l'utilisateur saisisse "toto" dans l'InputBox Numéro de référence... Tu vois à quoi ressemblera ta base d'ici quelques temps?
Tu peux tester donc le résultat avant de l'inscrire dans ta cellule.
Exemple pour imposer la saisie d'un nombre à deux chiffres :
Dim rep 

Do 
    rep = InputBox("Numéro de référence inexistant. Veuillez en indiquer un.", "NUMERO DE REFERENCE") 
'on boucle tant que rep n'est pas numérique ou que son nombre de caractère est différent de 2 : 
Loop While Not IsNumeric(rep) Or Len(rep) <> 2
cell.Value = rep

Cordialement,
Franck P
0
Re-bonjour,

J'ai bien vu que mon format de cellule n'était pas prise en compte et que s'il était saisi du texte, il y aurait des erreurs !
J'ai repris donc votre code et rajouter aussi celui-ci :
For Each cell In Range("A4", [a65000].End(xlUp))
        If Not IsNumeric(cell.Value) Then
        Call Rempli_Textbox 'rempli l'adresse et la valeur (vide) de la cellule en question dans le formulaire verification_ALL
            Do
            rep = InputBox("Numéro de référence inexistant. Veuillez en indiquer un.", "NUMERO DE REFERENCE", Range("A2").Value + 1)             'affecte une valeur à la cellule vide à travers une inputbox
            Loop While Not IsNumeric(rep)
            cell.Value = rep
        End If
        Calculate 'mise à jour de la cellule A2
    Next cell


Je n'avais jamais du le code du type :
Do
Something
Loop While something

Est-ce possible de faire de même pour d'autres boucle ?

J'ai tenu compte de vos autres remarques. Cependant, pour l'histoire de la dernière ligne du tableau (colonne A ou colonne B), l'utilisateur est sensé remplir toutes les lignes... Le numéro de la dernière ligne doit être la même pour chaque colonne en théorie.
En pratique, il arrive que la colonne B soit plus longue ou parfois, que la colonne A soit la plus longue.
Dois-je reprendre votre exemple en deux fois afin d'éviter ces subtilités ?

Merci encore.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
pijaku Messages postés 12259 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 9 août 2022 2 708
1 août 2012 à 10:04
1- Do - Loop While
Il s'agit de la même chose que Do While - Loop. Fais tant que ou boucle tant que...
A part que. Si, dans ton cas tu écris :
Dim rep
Do While Not IsNumeric(rep)
    rep = InputBox("Numéro de référence inexistant. Veuillez en indiquer un.", "NUMERO DE REFERENCE")
Loop

Sans rien ajouter, l'InputBox n'apparait pas puisque rep est vide donc considéré par VBA comme égale à zéro, donc numérique.....
Par contre, en demandant de boucler tant que, là elle apparait :
Do
    rep = InputBox("Numéro de référence inexistant. Veuillez en indiquer un.", "NUMERO DE REFERENCE")
Loop While Not IsNumeric(rep)

Pour que cela fonctionne avec Do While, tu as deux choix :
Code pas beau :
Dim rep
rep = "a"
Do While Not IsNumeric(rep)
    rep = InputBox("Numéro de référence inexistant. Veuillez en indiquer un.", "NUMERO DE REFERENCE")
Loop

Code pas beau non plus :
Dim rep
rep = InputBox("Numéro de référence inexistant. Veuillez en indiquer un.", "NUMERO DE REFERENCE")
Do While Not IsNumeric(rep)
    rep = InputBox("Numéro de référence inexistant. Veuillez en indiquer un.", "NUMERO DE REFERENCE")
Loop


2- dernière ligne non vide :
Ce code renvoie la dernière ligne absolue non vide dans la feuille, peu importe la colonne la plus "longue".
Attention: Si des lignes sont supprimées dans la plage, enregistrez préalablement le fichier pour que la procédure renvoie la réelle dernière ligne
Dim DerniereLigne As Long
DerniereLigne = Range("A1").SpecialCells(xlCellTypeLastCell).Row

Donc, si tu as peut être supprimé des lignes avant :
Dim DerniereLigne As Long
ActiveWorkBook.Save
DerniereLigne = Range("A1").SpecialCells(xlCellTypeLastCell).Row
0
Avec mes pauvres connaissances, je n'aurais pas fait un "beau code" ! ^^
Je ne connaissais pas la procédure qui renvoie la réelle dernière ligne.
En fait, peut-on dire qu'elle recherche dans la feuille le numéro de ligne de la dernière cellule remplie/non vide (peu importe la colonne) ?
0
pijaku Messages postés 12259 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 9 août 2022 2 708
1 août 2012 à 10:32
En fait, peut-on dire qu'elle recherche dans la feuille le numéro de ligne de la dernière cellule remplie/non vide (peu importe la colonne) ?

Oui.
En gros c'est ce que je te disais ici : Ce code renvoie la dernière ligne absolue non vide dans la feuille, peu importe la colonne la plus "longue".
0
Parfait, c'est exactement ce qu'il me fallait. Je n'ai plus qu'à appliquer ça à d'autres macros...
Merci pour votre aide précieuse.
0
pijaku Messages postés 12259 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 9 août 2022 2 708
1 août 2012 à 10:40
de rien.
A+
0