Ver originales (Francés)

Condiciones para duplicados en la misma celda

Resuelto
wuhrlinanthony Mensajes publicados 57 Estado Miembro -  
wuhrlinanthony Mensajes publicados 57 Estado Miembro -
Hola,

Estoy intentando crear una condición que me permita saber qué celda contiene dos veces el mismo código. Mi código es 88.1SX8, a veces aparece dos veces en la misma celda y como tengo 5000 filas, es un poco largo hacerlo a mano ^^. Si una celda contiene dos veces el mismo código, entonces la macro copia la fila entera a una nueva hoja. Si tienes alguna idea del código que puedo escribir, te lo agradeceré.

Gracias de antemano por tu ayuda.

Anthony

3 respuestas

  1.
    michel_m Mensajes publicados 18903 Fecha de registro   Estado Colaborador Última intervención   3 320
     
    Hola
    Habría que decirnos más sobre el contenido de las celdas

    88.1SX18 88.1SX18
    o
    88.1SX18blabla88.1SX18coucou
    o
    88.1SX18 blabla 88.1SX18 coucou
    o
    .....

    --
     Michel
    0
  2. Patrice33740 Mensajes publicados 8400 Fecha de registro   Estado Miembro Última intervención   1 784
     
    Hola,

    Prueba este código: 
    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


    --
    Cordialement
    Patrice
    0
  3. wuhrlinanthony Mensajes publicados 57 Estado Miembro
     
    Lo siento por la respuesta tardía, trabajo en el extranjero, así que hay desfase horario.

    michel_m los códigos son de esta forma: 88.1SX8#####,88.1SX8####
    No hay espacio entre los caracteres.

    Patrice33740, tu código funciona muy bien.

    Gracias.

    Anthony
    0