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
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 SubS 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
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