Message d'information concernant un doublon

Version imprimable

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:

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:

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

19/08/2016, 16h52
Menhir

Citation:

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.

Citation:

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

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:

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

19/08/2016, 17h45
Menhir

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.

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:

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

Code:

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

Bonjour.

Exemple de 2 boucles imbriquees en Visual Basic.

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

20/08/2016, 12h01
Invité

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!
20/08/2016, 15h26
Docmarti

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.
21/08/2016, 17h35
Arone77
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.
Citation:
Envoyé par rdurupt

Code:

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:

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

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

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

23/08/2016, 08h41
Menhir

Citation:

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.
23/08/2016, 11h13
Invité

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!

Bonjour.

Essaie ceci :

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

24/08/2016, 16h08
Arone77

1 pièce(s) jointe(s)

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.

Pièce jointe 218663

Qu'en pensez vous ?

Bien cordialement,
24/08/2016, 16h13
Invité
Bonjour,
je pensai avoir corrigé avant de poster mais ce n'est pas le cas :oops:
Code:

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!

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

Citation:

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:

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

Code:

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
Citation:

Envoyé par Menhir

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

24/08/2016, 17h50
Menhir

Encore plus simple :

Code:

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