Conditions pour un doublons dans la meme cellule [Résolu/Fermé]

Signaler
Messages postés
52
Date d'inscription
mercredi 29 juillet 2015
Statut
Membre
Dernière intervention
5 juillet 2017
-
Messages postés
52
Date d'inscription
mercredi 29 juillet 2015
Statut
Membre
Dernière intervention
5 juillet 2017
-
Bonjour,

J'essaye de creer une condition qui me permettrait de connaitre quel cellule contient deux fois le même code. Mon code est 88.1SX8, il est parfois écrit deux fois dans la même cellule et comme j'ai 5000 lignes c'est un peu long a la main ^^.
Si une cellule contient deux fois le même code, alors la macro copie la ligne entière dans un nouvel onglet.
Si vous avez une idée du code que je peux ecrire je suis preneur.

Merci d'avance pour votre aide.

Anthony

3 réponses

Messages postés
16395
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
5 mars 2021
3 146
Bonjour
Il faudrait nous en dire plus sue le contenu des cellules

88.1SX18 88.1SX18
ou
88.1SX18blabla88.1SX18coucou
ou
88.1SX18 blabla 88.1SX18 coucou
ou
.....
Messages postés
8486
Date d'inscription
dimanche 13 juin 2010
Statut
Membre
Dernière intervention
8 mars 2021
1 621
Bonjour,

Essaies ce code :
Option Explicit
Sub XXX()
Const str As String = "88.1SX8"
Dim src As Range
Dim dst As Range
Dim cel As Range
Dim adr As String
  ' Plage des données source
  Set src = Worksheets(1).UsedRange
  ' Destination des lignes copiées
  Set dst = Worksheets(2).Cells.SpecialCells(xlCellTypeLastCell)
  If Not (dst.Address = "$A$1" And dst.Formula = "") Then
    ' Première cellule de destination libre
    Set dst = dst.EntireRow.Cells(1, 1).Offset(1)
  End If
  ' Chercher la première cellule contenant la valeur (str)
  Set cel = src.Find(str, , xlValues, xlPart)
  If Not cel Is Nothing Then
    ' mémoriser l'adresse de la première cellule (pour sortie de boucle)
    adr = cel.Address
    Do
      ' Verifier la présence d'un doublon ...
      If InStr(2, cel.Value, str) > 0 Then
        ' ... si présent copier la ligne
        cel.EntireRow.Copy Destination:=dst
        ' cellule de destination suivante
        Set dst = dst.Offset(1)
      End If
      ' Chercher la cellule suivante contenant la valeur
      Set cel = src.Find(str, cel, xlValues, xlPart)
      If cel Is Nothing Then Exit Do
      If cel.Address = adr Then Exit Do
    Loop
  End If
End Sub 

Messages postés
52
Date d'inscription
mercredi 29 juillet 2015
Statut
Membre
Dernière intervention
5 juillet 2017

Désolé pour la réponse tardive, je travaille a l'etranger donc decalage horaire.

michel_m les codes sont de cette forme là : 88.1SX8#####,88.1SX8####
Il n'y a pas d'espace entre les caractères.

Patrice33740, ton code fonctionne très bien.

Merci.

Anthony