Message d'information concernant un doublon

**Arone77** · 19/08/2016, 16h32

Bonjour à tous,

Je viens à vous puisque je n'arrive pas à deux choses:

- Lorsque qu'il y a détection d'un doublon, ma Msgbox apparaît une première fois pour me dire le premier doublon apparaît à la ligne "X". Puis une deuxième fois pour me dire que le deuxième doublon est à la ligne "XX". Je souhaiterais faire apparaître le message qu'une seule fois en me disant "le N° de référence apparait deux fois, une fois à la ligne "X" et une fois à la ligne "XX".

-D'autre part, je n'arrive pas à coder pour faire apparaître la msgbox "aucun doublon détecté" s'il rien n'est trouvé.
J'ai essayé de coder :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 If Application.CountIf(Plage, Cel.Value) = "" Then
 
            MsgBox "il n'y a pas de doublons détectés"
       End if

Désolé pour le niveau de la question mais çà fait que deux semaines que je me suis lancé dans VBA et saisir la logique du code n'est pas chose facile !

Merci d'avance !!!

Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub CommandButton4_Click()
 
    Dim Plage As Range
    Dim Cel As Range
 
    With Worksheets("Base de données")
 
    'en colonne "B" à partir de A19
       Set Plage = .Range(.Cells(19, 2), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
   For Each Cel In Plage
 
        If Application.CountIf(Plage, Cel.Value) > 1 Then
 
            MsgBox "Attention, la réference de l'Appel d'Offre '" & Cel.Value & "' existe déja," _
                   & " veuillez trouver un des doubles à la ligne '" & Cel.Address(0, 0) _
                   & ""
                   End If
 
 
 
    Next Cel
 
End Sub

**Menhir** · 19/08/2016, 16h52

Envoyé par Arone77

- Lorsque qu'il y a détection d'un doublon, ma Msgbox apparaît une première fois pour me dire le premier doublon apparaît à la ligne "X". Puis une deuxième fois pour me dire que le deuxième doublon est à la ligne "XX". Je souhaiterais faire apparaître le message qu'une seule fois en me disant "le N° de référence apparait deux fois, une fois à la ligne "X" et une fois à la ligne "XX".

Dans ce cas, il faut que tu mettes une double boucle For imbriquées.
La première itère sur le critère de recherche, la seconde fait le recherche pour chaque élément de la première.
Si tu veux que le message n'apparaisse qu'une fois, il faut que ta recherche (la seconde boucle) ne se fasse pas sur la plage entière mais uniquement à partir de la cellule suivant celle qui sert de critère de recherche.

Pour accélérer, il est possible de remplacer la seconde boucle par l'utilisation d'un Find.

-D'autre part, je n'arrive pas à coder pour faire apparaître la msgbox "aucun doublon détecté" s'il rien n'est trouvé.

Déclare une variable de type Boolean.
Initialise-la à la valeur True.
Lorsque tu trouves un double, passe-la à False.
A la fin de ton code, teste-la : si elle est True, alors affiche ton MsgBox.

**Arone77** · 19/08/2016, 17h27

En essayant de faire pour la première fois un for imbriqué,
j'ai écris quelque chose ca mais ca ne fonctionne pas

Qu'en pensez vous ?
J'ai nomé resultat as range

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
For Each Cel In Plage
    For Each Resultat In Plage
        If Application.CountIf(Plage, Cel.Value) = Application.CountIf(Plage, Resultat.Value) Then
 
 
            MsgBox "Attention, la réference de l'Appel d'Offre '" & Cel.Value & "' existe déja," _
                   & " veuillez trouver un des doubles à la ligne '" & Cel.Address(0, 0) '"& resultat.Address(0, 0)_
                   
                   End If
 
  Next Cel
 Next Resultat
End Sub

**Menhir** · 19/08/2016, 17h45

Je n'ai pas regardé ton code en détail mais une chose pique les yeux d'entrée : tes deux boucles ne sont pas imbriquées, elles sont croisées, ce qui, informatiquement parlant, est très mal (presque autant que de croiser les flux dans Ghostbusters

).
C'est comme les rimes en poésie : tes For / Next devraient se lier comme des rimes embrassées et non comme des rimes croisées.
https://fr.wikipedia.org/wiki/Rime#Rimes_de_fin_de_vers

Autrement dit, il faudrait que tu intervertisses soit tes deux For, soit tes deux Next.

**Arone77** · 19/08/2016, 18h24

J'ai inversé, j'ai espéré, j'ai appuyé sur F8, le curseur est passé, j'ai espéré un peu plus, j'ai testé un doublon... et c'était raté ! J'ai trafiqué, j'ai cherché... et j'y suis pas arrivé !!!!

Je donne ma langue au chat

C'est possible ?!

Dernier code tenté :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub CommandButton4_Click()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim Resultat As Range
    Dim A As Boolean
 
    With Worksheets("Base de données")
 
    'en colonne "B" à partir de A19
       Set Plage = .Range(.Cells(19, 2), .Cells(.Rows.Count, 1).End(xlUp))
 
    End With
 
   For Each Cel In Plage
    For Each Resultat In Plage
 
        If Application.CountIf(Plage, Cel.Value) = Application.CountIf(Plage, Resultat.Value) > 1 Then
        A = False
            MsgBox "Attention, la réference de l'Appel d'Offre '" & Cel.Value & "' existe déja," _
                   & " veuillez trouver un des doubles à la ligne '" & Cel.Address(0, 0) & Resultat.Address(0, 0) & "'" _
                    & ""
                   End If
 
    Next Resultat
  Next Cel
  If A = True Then
    MsgBox "il n'y a pas de doublon détecté"
End if
End sub

Invité · 19/08/2016, 20h50

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Set d = CreateObject("Scripting.Dictionary")
With Worksheets("Base de données")
 
    'en colonne "B" à partir de A19
       Set palge = .Range(.Cells(19, 2), .Cells(.Rows.Count, 2).End(xlUp))
For i = 1 to  palge.rows.count
    'en colonne "B" à partir de A19
     if d.existes(  palge(i).value)=True then msg=msg & palge(i).Address & vbcrlf
     d(palge.(i).value=palge.(i).value
Next
If msg<>"" then MsgBox "Attention, la référence de l'Appel d'Offre " & vbcrlf & msg
    End With

**Docmarti** · 19/08/2016, 23h23

Bonjour.

Exemple de 2 boucles imbriquees en Visual Basic.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub For_For_Next_Next()
 
'2 boucles imbriquees
 
Feuil6.Activate
 
dern = Cells(Rows.Count, "B").End(xlUp).Row
 
separe = Chr(15)
DejaAnalyser = separe
 
For i = 1 To dern
 
 Valeur = Cells(i, "B").Value
 
 txt = ""
 If InStr(DejaAnalyser & separe, separe & Valeur & separe) > 0 Then
 
 Else
 DejaAnalyser = DejaAnalyser & Valeur & separe
 
 For J = i + 1 To dern
  ValeurJ = Cells(J, "B").Value
 
  If ValeurJ = Valeur Then
 
   txt = txt & J & vbLf
 
  End If
 
 Next
 
 If txt <> "" Then
   txt = Valeur & vbLf & i & vbLf & txt
   MsgBox txt
 End If
 
End If
 
Next
End Sub

Invité · 20/08/2016, 12h01

Bonjour,
L'ennui avec les doubles boucle c'est que le nombre de rotation est rows.count *rows.count soit 100 pour un onglet de 10 lignes. On imagine pour 1000 lignes!

Un dictionnaire (collection) mémorisera les valeurs de chaque ligne et pourra informer le programme d'un doublon, donc pas de double boucle!

**Docmarti** · 20/08/2016, 15h26

Bonjour Robert.

Tu as raison.
Sur mon vieil ordi, il faut plus de 5 secondes pour 1000 lignes avec 2 boucles imbriquées.
Avec 2 dictionnaires, c'est réglé en 3 centièmes de seconde.
C'est la différence entre lire 1000 lignes une fois et lire 1000 lignes 1000 fois.

**Arone77** · 21/08/2016, 17h35

Bonjour,

j'ai essayé votre code mais je ne parviens pas à l'adapter. En effet, je trouve étrange la deuxième du code qui se trouve ci dessous.

Envoyé par rdurupt

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
 
     if d.existes(  palge(i).value)=True then msg=msg & palge(i).Address & vbcrlf
     d(palge.(i).value=palge.(i).value

L'erreur annoncé est: erreur de syntaxe.
J'ai essayé de corriger en écrivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
 
     if d.existes(palge(i).value)=True then msg=msg & palge(i).Address & vbcrlf
     d(palge(i).value)=palge(i).value

Mais le message d'erreur annoncé est de type "438- ¨propriété ou méthode non gérée par cet objet".
D'autre part, il n'y pas = False dans le code, est ce normal ?

Merci pour votre aide... !

Invité · 22/08/2016, 23h45

bonsoir,
désolé mais il est vrai que je suis en mode vacances!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Private Sub CommandButton4_Click()
 Dim Lst As Object, I As Long, Msg As String
 Set Lst = CreateObject("System.Collections.SortedList")
    Dim Cel As Range
 
    With Worksheets("Base de données")
 
    'en colonne "B" à partir de A19
 
 
   For Each Cel In .Range(.Cells(19, "B"), .Cells(.Rows.Count, "B").End(xlUp))
 
        If Lst(Cel.Value) = "" Then Lst(Cel.Value) = Cel.Address Else Lst(Cel.Value) = Lst(Cel.Value) & ";" & Cel.Address
 
    Next Cel
  End With
 
  For I = 0 To Lst.Count - 1
  If UBound(Split(Lst(Lst.GetKey(I)) & ";", ";")) Then Msg = Msg & Lst.GetKey(I) & " : " & Lst(Lst.GetKey(I)) & vbCrLf
    Debug.Print
 
  Next
  If Msg <> "" Then MsgBox Msg
End Sub

**Menhir** · 23/08/2016, 08h41

Envoyé par Arone77

D'autre part, il n'y pas = False dans le code, est ce normal ?

Mettre =True ou =False dans un test en VBA est une tautologie informatique.

Invité · 23/08/2016, 11h13

Bonjour Menhir et Arone77,

J'aime bien cette expression et je devrais l'utiliser également car elle dit bien ce qu'elle veut dire.

En effet si par exemple je regarde si j'ai de l'argents pour faire mes courses, le fait d'être fauché de m'intéresse pas car dans les faits si je n'ai pas d'argents je ne pourrais rien acheter!

**Docmarti** · 24/08/2016, 10h39

Bonjour.

Essaie ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub For_For_Next_Next_2()
'2 boucles imbriquees
 
Feuil1.Activate
 
separe = Chr(15)
 
'Recherche doublons dans colonne B
 
DejaAnalyser = separe
 
dern = Cells(Rows.Count, "B").End(xlUp).Row
 
For i = 19 To dern
 
 valeur_I = Cells(i, "B").Value
 
 txt = ""
 
 If InStr(DejaAnalyser & separe, separe & valeur_I & separe) > 0 Then
 
 Else
 DejaAnalyser = DejaAnalyser & valeur_I & separe
 
 For J = i + 1 To dern
  valeur_J = Cells(J, "B").Value
 
  If valeur_J = valeur_I Then
 
   txt = txt & J & " "
 
  End If
 
 Next
 
 If txt <> "" Then
   TrouverDoublons = True
 
   txt = valeur_I & vbLf & i & " " & txt
 
   MsgBox txt
 
 End If
 
End If
 
 
Next
 
If TrouverDoublons = True Then
 MsgBox "Fin de la recherche"
Else
 MsgBox "Aucun doublon"
End If
 
End Sub

**Arone77** · 24/08/2016, 16h08

Bonjour à tous,

Je n'avais pas reçu de notifications signalant vos réponses, excusez moi !!! Merci à tous !

Docmarti, merci de votre réponse, elle fonctionne ! mais malheureusement, concernant mon cas, la démarche de boucle imbriquée est trop lourde. Pour analyser mes 7 000 lignes, l'opération met 4 minutes et excel se met en mode "bug" et "ne répond pas" pendant ce temps là.

Concernant votre publication rdurupt, votre dernier code ne révèle pas de bug mais il de détecte pas de doublons. Plus étrange, la msgbox qui apparaît m'indique une série de ligne accompagné de leur numéro de Siren comme indiqué sur la photo ci dessous.

Doc11.pdf

Qu'en pensez vous ?

Bien cordialement,

Invité · 24/08/2016, 16h13

Bonjour,
je pensai avoir corrigé avant de poster mais ce n'est pas le cas

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For I = 0 To Lst.Count - 1
  If UBound(Split(Lst(Lst.GetKey(I)) & ";", ";"))>1 Then Msg = Msg & Lst.GetKey(I) & " : " & Lst(Lst.GetKey(I)) & vbCrLf
  Next

normalement tu devrais avoir tous numéro de Siren en doublon ainsi que l'adresse des cellules concernées!

**Arone77** · 24/08/2016, 17h01

Merci 1000 fois, ce problème est résolu. Quelle merveille l'utilisation de cet objet

CreateObject("System.Collections.SortedList")

!!!

Je me suis permis d'intégrer dans votre code ma fonction booléen qui permet de m'indiquer qu'il n'existe pas de doublons !!!

Voici mon code final !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub CommandButton4_Click()
 Dim Lst As Object, I As Long, Msg As String
 Set Lst = CreateObject("System.Collections.SortedList")
    Dim Cel As Range
    Dim A As Boolean
 
    With Worksheets("DB-MOAPUBLIC")
 
    'en colonne "A" à partir de A10
 
 
   For Each Cel In .Range(.Cells(10, "A"), .Cells(.Rows.Count, "A").End(xlUp))
 
        If Lst(Cel.Value) = "" Then Lst(Cel.Value) = Cel.Address Else Lst(Cel.Value) = Lst(Cel.Value) & ";" & Cel.Address
 
    Next Cel
  End With
 
 For I = 0 To Lst.Count - 1
  If UBound(Split(Lst(Lst.GetKey(I)) & ";", ";")) > 1 Then Msg = Msg & " Le numéro de SIREN/SIRET (" & Lst.GetKey(I) & ") existe en double aux lignes suivantes : " & Lst(Lst.GetKey(I)) & vbCrLf
    Debug.Print
 
  Next
 
  If Msg <> "" Then MsgBox Msg
  A = True
  If Msg = "" Then A = False
  If A = False Then MsgBox "Il n'existe pas de numéro de SIREN/SIREN en double dans ce tableau"
 
End Sub

Invité · 24/08/2016, 17h23

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
If Msg <> "" Then 
        MsgBox Msg
Else
       MsgBox "Il n'existe pas de numéro de SIREN/SIREN en double dans ce tableau"
End if

Envoyé par Menhir

Mettre =True ou =False dans un test en VBA est une tautologie informatique.

**Menhir** · 24/08/2016, 17h50

Encore plus simple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MsgBox  IIf(Msg <> "", Msg, "Il n'existe pas de numéro de SIREN/SIREN en double dans ce tableau")

Message d'information concernant un doublon

Macros et VBA Excel

Discussions similaires

Partager

Partager