Forums Últimos mensajes - Powered by IBM
 

Macro elimina Repetidos y Valores con Trama

22/07/2005 - 23:49 por HMS | Informe spam
Hola a Tod@s

Estoy utilizando la macro, abajo expuesta para eliminar FILAS completas con
valores repetidos en la columna A,

Pero quisiera que a la vez se puedan eliminar las FILAS COMPLETAS de la
misma BD, pero que contenga cualquier Tipo de TRAMA en la
Columna B de la Base de Datos
Sub BorrarDuplicados()
Dim wksH As Worksheet
Dim lngContFila As Long
Set wksH = Worksheets("Hoja1") 'Hoja que se procesará

lngContFila = 1 'Si hay títulos tendrá que ser 2

While Not IsEmpty(wksH.Cells(lngContFila, intNúmCol))
If Application.WorksheetFunction.CountIf(wksH.Columns(intNúmCol),
wksH.Cells(lngContFila, intNúmCol)) > 1 Then
wksH.Cells(lngContFila, intNúmCol).EntireRow.Delete
Else
lngContFila = lngContFila + 1
End If
Wend

Set wksH = Nothing
End Sub

HMS
 

Leer las respuestas

#1 Héctor Miguel
23/07/2005 - 02:44 | Informe spam
hola, 'tocayo' !

... la macro, abajo expuesta para eliminar FILAS completas con valores repetidos en la columna A,
... quisiera... a la vez... eliminar las FILAS ... misma BD... que contenga cualquier Tipo de TRAMA en la Columna B [...]



te paso un ejemplo con 'otra' forma de eliminar duplicados [sobre la hoja activa]
-> siempre y cuando el numero de 'areas' [o rangos discontinuos] 'final' NO exceda de 2048 :(
[o seria necesario 'anticipar' con una 'deteccion' y re/iniciar el proceso -misma macro-] ;)
lo que no me queda claro es si se eliminan...
a) los duplicados SI [y solo si] ->ademas<- existe alguna trama [o color] en su celda 'contigua' ???
b) o los duplicados MAS ->cualquiera<- que tenga trama [o color] en su celda 'contigua' [AUN si son 'unicos'] ???
-> si fuera el caso 'a'... cambia en la linea 9 de la macro la instruccion -> 'Or' -> por -> 'And' :))

si cualquier duda [o informacion adicional]... comentas?
saludos,
hector.
en un modulo de codigo 'normal' ==Sub Eliminar_Repetidos_Entramados()
Dim Eliminar As Range, Col As String, F1 As Long, Fx As Long, Fila As Long
Application.ScreenUpdating = False
Col = "a"
F1 = 2
Fx = Range(Range(Col & F1), Range(Col & "65536").End(xlUp)).Rows.Count
For Fila = F1 To Fx + F1 - 1
If Application.CountIf(Range(Col & F1 & ":" & Col & Fila), Range(Col & Fila)) > 1 _
Or Range(Col & Fila).Offset(, 1).Interior.ColorIndex <> xlColorIndexNone Then
If Eliminar Is Nothing Then Set Eliminar = Range(Col & Fila)
Set Eliminar = Union(Eliminar, Range(Col & Fila))
End If
Next
If Not Eliminar Is Nothing Then Eliminar.EntireRow.Delete: Set Eliminar = Nothing
End Sub

Preguntas similares