Amélioration d’une macro qui détecte valeur en double

Salut le forum,

Pourriez-vous m’aider à faire une amélioration pour une macro qui détecte les valeurs en double.

La macro ajoute .bis à la valeur en double

L’amélioration souhaitée ; si la cellule 1 a une valeur identique à la cellule -1 alors pas de changement dans la cellule 1

Exemple :

ci-joint mon fichier Excel avec la macro, merci d'avance

Bonsoir à tous!

Niba, 2 solutions que tu auras à adapter avec colonne supplémentaire ou sans colonne supplémentaire

vois si cela te convient

'SANS COLONNE SUPPLÉMENTAIRE
Sub test()
Dim c As Variant
dl = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False

compt = 0
For i = 2 To dl
    For Each c In Range("A2:A15")
        If c = Cells(i, 1) Then
compt = compt + 1
    X = compt
    End If
Next c
    compt = 0
        If X >= 2 Then
        Cells(i, 1) = Cells(i, 1) & ".bis"
End If
Next i
'TRI DE LA COLONNE FACULTATIF
Range("A1").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
Columns("B:B").ClearContents
Application.ScreenUpdating = True
End Sub

'AVEC COLONNE SUPPLÉMENTAIRE
Sub test2()
Dim c As Variant
dl = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
compt = 0

For i = 2 To dl
    For Each c In Range("A2:A15")
        If c = Cells(i, 1) Then
compt = compt + 1
        c.Offset(, 1) = compt
        End If
Next c
    compt = 0
        If Cells(i, 2) >= 2 Then
    Cells(i, 1) = Cells(i, 1) & ".bis"
End If
Next i
Columns("B:B").ClearContents
Application.ScreenUpdating = True
End Sub

Bonne soirée!

Bonjour à tous,

Une variante....avec l'utilisation d'un dictionnaire....

source: https://excel-downloads.com/threads/surligner-les-doublons-mais-pas-la-premiere-occurrence.20061432/...

Cordialement

Bonjour,

merci pour vos repense, mais y a un problème

c'est que pour l'exécution de la macro la première fois ca a l'aire bien, mais si je ajoute d'autres nombres et je fait exécuter le même problème ca se répète

exécution une deuxième fois après saisie d'autres nombres

merci bien pour votre support

Re,

Merci pour le retour,

Un essai...

Sub doublons()
 Dim dico As Object, tb, i&, valeur$, ar, dl&
  Set dico = CreateObject("Scripting.Dictionary")
   Application.ScreenUpdating = False
    With Sheets("Feuil1")
     dl = .Range("A" & Rows.Count).End(xlUp).Row
      tb = .Range("A1:A" & dl)
       For i = 1 To UBound(tb)
        ar = Split(CStr(tb(i, 1)), ".bis"): valeur = ar(0)
         If valeur <> "" Then
          If dico.exists(valeur) Then
           .Cells(i, 1).Value = valeur & ".bis"
          Else
           dico(valeur) = valeur
         End If
        End If
       Next i
    End With
   Erase tb: Set dico = Nothing
End Sub

Cordialement,

Re,

Merci pour le retour et pour avoir passé le sujet en résolu,

Bonne continuation,

Bonjour à tous!

Niba, désolé je n'avais pas re-testé en y ajoutant d'autres chiffres

xorsankukai, bien vu pour la réponse Bravo!

une autre solution que j'ai pensé c'est de remplacer tous les .bis par rien et refaire la macro

'SANS COLONNE SUPPLÉMENTAIRE
Sub test()
Dim c As Variant
dl = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
Cells.Replace What:=".*", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
compt = 0
For i = 2 To dl
    For Each c In Range("A2:A50")
        If c = Cells(i, 1) Then
compt = compt + 1
    X = compt
    End If
Next c
    compt = 0
        If X >= 2 Then
        Cells(i, 1) = Cells(i, 1) & ".bis"
End If
Next i
'TRI DE LA COLONNE FACULTATIF
Range("A1").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
Application.ScreenUpdating = True
End Sub

Bonne journée!