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

A voir également:

Repérer des doublons en VBA
Supprimer les doublons excel - Guide
Doublons photos - Guide
Supprimer les doublons photos gratuit - Télécharger - Nettoyage
Incompatibilité de type vba ✓ - Forum Programmation
Vba attendre 1 seconde ✓ - Forum VB / VBA

5 réponses

Réponse 1 / 5

tuxboy Messages postés 994 Date d'inscription lundi 23 juillet 2012 Statut Membre Dernière intervention 28 mai 2019 189
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 !

mcou
26 juil. 2012 à 15:31

je m'y atèle !

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
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...

mcou
26 juil. 2012 à 15:55

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...

tuxboy Messages postés 994 Date d'inscription lundi 23 juillet 2012 Statut Membre Dernière intervention 28 mai 2019 189
26 juil. 2012 à 15:56

r... à supprimer.

mcou
26 juil. 2012 à 16:09

heureusement que je ne travaille pas sur mes données mais sur un fichier vierge.
pikaju, aurais-tu une idée à me suggérer ?

Réponse 2 / 5

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
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

mcou
31 juil. 2012 à 10:33

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 ?

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
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

mcou
31 juil. 2012 à 16:43

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.

Réponse 3 / 5

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
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

mcou
1 août 2012 à 08:47

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

Réponse 4 / 5

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
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

mcou
1 août 2012 à 09:48

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.

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

Posez votre question

Réponse 5 / 5

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
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

mcou
1 août 2012 à 10:29

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) ?

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
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".

mcou
1 août 2012 à 10:37

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.

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 744
1 août 2012 à 10:40

de rien.
A+

Discussions similaires

"L'indice n'appartient à la sélection" + VBA

VBA : Range avec références variables..

VBA erreur 1004

ouverture d'un fichier excel à partir d'un code VBA

Méthode find dans VBA - Recherche de données sous Excel

Discussions similaires

Newsletters