Vba para identificar valores dupliacados de una misma celda

Por ejemplo tengo en mi columna "A" los siguientes números

A1 )    1021 ; 1023 ; 2012; 1023 

A2) 0989; 2344; 2134; 1093 

A3) 0321;3431;1234;140

Y así sucesivamente

Necesito una macro que me identifique en que CELDAS los valores están repetidos en este caso vemos que en "A1" se repite 1023 entonces necesito algo que me diga que en la celda "a1" se repite y así sucesivamente en los casos que estén repetidos..

2 respuestas

Respuesta
2

Te anexo la macro. Si en la columna A existe un duplicado, entonces en la columna B te va a poner el texto "Tiene duplicados".

Sub Validar_Duplicados()
'Por Dante Amor
    Dim col As New Collection
    On Error Resume Next
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        Set col = Nothing
        nums = Split(Cells(i, "A").Value, ";")
        For j = LBound(nums) To UBound(nums)
            num = Trim(nums(j))
            col.Add Item:=Trim(nums(j)), Key:=Trim(nums(j))
        Next
        If col.Count < UBound(nums) + 1 Then Cells(i, "B") = "Tiene duplicados"
    Next
    MsgBox "Fin"
End Sub

S a l u d o s . D a n t e   A m o r
[' Si es lo que necesitas. No olvides valorar la respuesta. 

Hola de nuevo, la macro si la corre pero me pone "TIENE DUPLICADOS " en celdas que no hay duplicados por ejemplo :

A3) " ;193083;194250; " me dice que tiene tduplicados en b3 y solo hay dos datos y no están duplicados :)

Te anexo la actualización, no contaba con que tuvieras ; antes y/o después de tus números, ya que en los ejemplos no aparecían.

Prueba con la siguiente:

Sub Validar_Duplicados()
'Por Dante Amor
    Dim col As New Collection
    On Error Resume Next
    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
        Set col = Nothing
        nums = Split(Cells(i, "A").Value, ";")
        n = UBound(nums)
        For j = LBound(nums) To UBound(nums)
            num = WorksheetFunction.Trim(nums(j))
            If num <> "" Then col.Add Item:=num, Key:=num Else n = n - 1
        Next
        If col.Count < n + 1 Then Cells(i, "B") = "Tiene duplicados"
    Next
    MsgBox "Fin"
End Sub
Respuesta
1

Checa esta macro

Sub contar_repetidos()
Dim funcion As WorksheetFunction
Set funcion = WorksheetFunction
Range("a:a").Replace what:=" ", replacement:=""
Set datos = Range("a1").CurrentRegion
With datos
    r = .Rows.Count: c = .Columns.Count
    For i = 1 To r
        valor = .Cells(i, 1)
        separa = Split(valor, ";")
        cuenta = UBound(separa) + 1
        .Columns(c + 3).CurrentRegion.ClearContents
        Set numeros = .Columns(c + 3).Resize(cuenta, 1)
        With numeros
            Range(.Address) = funcion.Transpose(separa)
            For j = 1 To .Rows.Count
                numero = .Cells(j, 1)
                .Cells(j, 2) = funcion.CountIf(.Columns(1), numero)
            Next j
            Set numeros = .CurrentRegion
          .RemoveDuplicates Columns:=Array(1, 2)
        End With
        .Cells(i, 2) = funcion.Max(numeros.Columns(2))
    Next i
    .EntireColumn.AutoFit
    numeros.ClearContents
End With
Set datos = Nothing: Set numeros = Nothing: Set funcion = Nothing
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas