Trouver les doublons

[RENAUDER]

Bonjour,
J'ai une liste de commandes malheureusement disparate et je souhaite trouver les commandes en doublons.
😕 J'ai recherché du coté de FIND, LIKE mais je ne décolle pas, je ne vois pas comment m'y prendre.
Je fais appel à la communauté pour savoir si quelqu'un aurait une piste à me proposer.

Numéro de commande
45003467
45003280
45003450
45003280* est un doublon du 45003280
Cde 77560
77340
77456
Cde 77560 B est un doublon de Cde 77560
45003600
45004560
D'avance merci.

 

[BOISGONTIER]

Re : Trouver les doublons

Voir PJ

Sub essai()
 [B:B].ClearContents
 For Each cel In [champ]
  Set c = [champ].Find(what:=cel, LookAt:=xlPart)
  If Not c Is Nothing Then
      premier = c.Address
      Do
        If cel.Value <> c.Value Then
          cel.Offset(, 1) = cel.Offset(, 1) & " Dbl de: " & c & " en " & c.Address
          c.Interior.ColorIndex = 36
        End If
        Set c = Range("champ").FindNext(c)
      Loop While Not c Is Nothing And c.Address <> premier
  End If
Next cel
End Sub

JB

 

[RENAUDER]

Re : Trouver les doublons

Bonjour Hasco,
Oui mais ce qui est bizarre, si je mets par exemple comme dernière valeur :
cde 77561D
il me met doublon de: 45003280 et pourquoi ???
et si je mets
cde 77561 D ou 25789, il ne trouve pas de doublon met pas doublon
J'avoue y perdre mon latin

 

[RENAUDER]

Re : Trouver les doublons

Jacques,
Je ne t'avais pas encore lu dans mon fil précédent mais je pense que
ton code solutionne mon cas.
Je triture tout cela pour vérifier.
Merci

 

[job75]

Re : Trouver les doublons

Bonjour Eric, le fil,

J'y vais aussi de ma solution, qui vaut ce qu'elle vaut :

Sub Doublons()
Dim d As Long, tablo(), i As Long, j As Long, lig As Long, doublon$
Application.ScreenUpdating = False
Range("D2:D65536").ClearContents
d = Range("A65535").End(xlUp).Row
ReDim tablo(1 To d, 1 To 2)
For i = 1 To d
  tablo(i, 1) = Application.Trim(Cells(i, 1))
  tablo(i, 2) = Val(Replace(tablo(i, 1), "Cde", ""))
  If tablo(i, 2) = 0 Then tablo(i, 2) = tablo(i, 1)
Next
lig = 1
For i = 1 To d - 1
  If tablo(i, 1) <> "" Then
    doublon = ""
    For j = i + 1 To d
      If tablo(i, 2) = tablo(j, 2) Then
        If doublon = "" Then doublon = tablo(i, 1) & "[" & i & "]": lig = lig + 1
        doublon = doublon & " - " & tablo(j, 1) & "[" & j & "]"
        tablo(j, 1) = ""
      End If
    Next
    If doublon <> "" Then Cells(lig, 4) = doublon
  End If
Next
End Sub

A+