Trouver doublons colonne "A" et lister les numéros des lignes

Bonjour à tous,

J'ai des cellules en double en colonne "A", je souhaite (Avec du vba S.V.P) avoir un Msgbox qui m'indique la valeur de chaque cellule en double, suivi des numéros des lignes où ce doublon se trouve, merci de proposer un seul affichage pour tous les doublons avec un seul Msgbox.

Ce qui veux dire que nous allons avoir la liste de chaque doublon, suivi des numéros des lignes en double comme ceci :

"876-054/2004 F" se trouve aux lignes : 2 – 3 – 7

"0811-076/2006 M" se trouve aux lignes : 5 – 25

"SC55-075/2007 F" se trouve aux lignes : 14 – 15

"838-010/2008 M" se trouve aux lignes : 14 – 15

"SC55-017/2008 M" se trouve aux lignes : 22 – 23 – 24 – 25

Il est important que je puisse récupérer les numéros des lignes via un Msgbox visuellement.

J'ai trouvé des solutions qui mettent les mêmes cellules en double en couleur mais malheureusement cette solution ne me convient pas.

Je reste à votre disposition au besoin.

Merci pour vos contributions.

Bonsoir,

Harzer a écrit :

je souhaite (Avec du vba S.V.P)

Depuis le temps que tu demandes de l'aide sur tes fichiers de volatiles....

Et que tant de propositions t'ont été faites avec du "Power Query"

Tu persistes à vouloir utiliser ce "VBA" que tu ne maîtrises pas plus que "PQ"

Juste une question, pourquoi cette restriction?

Ah, je n'ai pas ouvert ton fichier, cf ton exigence....

Hello,

Je rejoins cousinhub mais sinon voici une fonction personnalisé en VBA. Deux arguments, la plage et la valeur recherchée.

Function LignesOccurrences(plage As Range, valeur As String) As String
    Dim c As Range, res As String
    For Each c In plage
        If c.Value = valeur Then res = res & c.Row & "/"
    Next c
    If res <> "" Then res = Left(res, Len(res) - 1)
    LignesOccurrences = res
End Function

Un exemple dans ce fichier

@+

Bonjour Harzer, cousinhub, BAROUTE78,

Une version avec Msgbox.

Le code dans Module1:

Sub Doublons()
Dim der&, d, x, y, s$, n&
   Set d = CreateObject("scripting.dictionary")
   With Worksheets("Parents")
      der = .UsedRange.Row + .UsedRange.Rows.Count - 1
      If der <= 2 Then MsgBox "Aucun Doublons", vbInformation: Exit Sub
      For Each x In .Range("a2:a" & der).Cells
         y = x.Value: If Trim(y) <> "" Then d(y) = d(y) & ", " & x.Row
      Next
      If d.Count > 0 Then
         For Each x In d.keys
            d(x) = Mid(d(x), 3)
            If InStr(d(x), ", ") > 0 Then n = n + 1: s = s & vbLf & x & " -> " & d(x)
         Next x
      End If
      If n > 0 Then MsgBox Mid(s, 2), vbInformation Else MsgBox "Aucun Doublons", vbInformation
   End With
End Sub

Bonjour cousinhub, BAROUTE78 et mafraise

Merci cousinhub pour ton retour, en effet, je ne maitrise pas vba et encore moins le PQ, une chose qui est sûr, lorsqu'on me propose une solution en vba, j'arrive à l'ajouter à mon fichier, ce qui n'est pas le cas en PQ.

Merci également à BAROUTE78 et mafraise pour vos propositions respectives, elles fonctionnent toutes les deux, merci encore.

Cordiale poignée de mains.