Quitar registros duplicados

Estimado estaré muy agradecido si me das una manito con este código para Excel. Mira tengo los sieguientes registros...
En la celda D4 a la D27, tengo varios registros... Varios de ellos iguales...
Pero quiero que quede 1 de cada uno...
Mira te adjunto el código.
 Range("D4:D27").Select
    ActiveSheet.Range("$D$4:$D$27").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("D3").Select
Este lo hice en la version excel 2007, pero no funciona en 2003...(y es esta la que ocupo,,,, lo bueno es que las macros que realizo en 2003 las asume el 2007,,,, pero NO FUNCIONA AL REVÉS...)
Estaré muy agradecido y atento de tu gestión,,,,.
Respuesta
1
En Excel en su versión 2007, no existe una función especifica que elimine los registros duplicados, para esto deberás crear una macro en la cual comparas las celdas entre sí y así ir eliminando o borrando los duplicados, para crear esta macro puedes ayudarte con las funciones de "FIND"
Te dejo una macro que puedes utilizar para eso.
Donde:
--Valor es variant
--celda es string
--X es entero
Esta macro compara el valor de la primera celda (en este caso "D4") y donde encuentra un valor igual lo borra (en este caso lo sustituye por "", que indica vacío).
La pones dentro de una función o de una sub y listo, puedes modificar según te convenga.
'*******Comienza aki*****
For x=4 to 27 then
  valor=cells(x,"D")
  If valor<>Vacío then
     celda=cells(x+1,"D")
     With worksheets("Hoja1").Range(celda,"D27")
        set c=.Find(valor)
        If Not c Is Nothing then
           Do
              c.Value="" 
              Set c.FindNext(c)
           Loop While Not c Is Nothing 
        End If
   End With
 End If
Next x
Estimado(a)
Te comento
No son muy avil en esto puesto que solo soy aprendiz,,,, pero lo coloque dentro de un Commandbuton... y ademas que hacia referencia a esta área D4 al D27,,, así de esta forma:
Private Sub CommandButton1_Click()
 For x=4 to 27 then ' SE COLO DE COLOR ROJO
  valor = Cells(x, "D")
  If valor <> Vacío Then
     celda = Cells(x + 1, "D")
     With Worksheets("Hoja1").Range(celda, "D27")
        Set c = .Find(valor)
        If Not c Is Nothing Then
           Do
              c.Value = ""
              Set c.FindNext(c) ' SE COLOCO DE COLOR ROJO
           Loop While Not c Is Nothing
        End If
   End With
 End If
Next x
End Sub
Sin embargo se colo de color rojo dos lineas del código...
Debe ser algo poquito que le falta...
Atento a tus comentarios
Ariel
Disculpame error a la hora de transcribir, te pido que me disculpes por no haberme fijado en esos detallitos.
En el error del For es que ahí no lleva then, disculpa creo que me quedé con la idea del if.
Eso debe quedar así:
for x=4 to 27 
o si te llegase a marcar error cosa que no creo pero en todo caso pon esto
for x=4 to 27 step 1
En cuanto al del find quedaría de esta manera:
Set c = .FindNext(c)
Con esto ya no debes tener ningún problema.
Perdona pero lo probé de todas formas y aun persiste AL ERROCITO, te muestro donde falla
For x = 4 To 27 Step 1
  valor = Cells(x, "D")
  If valor <> Vacío Then
     celda = Cells(x + 1, "D")
     With Worksheets("Hoja1").Range(celda, "D27") 'se coloco de marillo
        Set c = .Find(valor)
        If Not c Is Nothing Then
           Do
              c.Value = ""
              Set c = .FindNext(c)
           Loop While Not c Is Nothing
        End If
   End With
 End If
Next x
Me muestra un Msg Box que DICE:
Se ha producido el error '1004' en tiempo de ejecución
error definido por la aplicación o el objeto...
Estamos casi ya...
Copia esto y sustituye el anterior, ya quedó bien, Disculpa los errores al momento de transcribir la macro, he estado un poco distraída últimamente. Saludos
For x=4 to 27 
  valor = Cells(x, "D") 
  If valor <> Vacío Then 
     celda = Cells(x + 1, "D").Address
     With Worksheets("Hoja1").Range(celda, "D27") 
        Set c = .Find(valor) 
        If Not c Is Nothing Then 
           Do 
              c.Value = "" 
              Set c=.FindNext(c) 
           Loop While Not c Is Nothing 
        End If 
   End With 
 End If

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas