Ver Mensaje Individual
  #1 (permalink)  
Antiguo 26/03/2010, 05:50
fesero
 
Fecha de Ingreso: junio-2008
Ubicación: Punta Alta, Argentina
Mensajes: 82
Antigüedad: 16 años, 5 meses
Puntos: 0
VBA excel eliminar rango de filas duplicadas

buenas, tengo una hoja de excel con el siguiente formato

Nº op Nº Orden Fecha Detalle
1 01-01-10 CARNICERIA LA PERLA
2 01-01-10 ALERTA
3 04-01-10 LOREA
4 05-01-10 LA AGRONOMIA
5 05-01-10 PANADERIA SAN CEFERINO
2 01-01-10 ALERTA
3 04-01-10 LOREA
4 05-01-10 LA AGRONOMIA

el nro de operacion es unico, es decir que las filas que contengan el mismo nro de op significa que son identicas y por lo tanto quiero eliminarlas.

esto es lo que he intentado hacer

Código:
' 
' 
' 
Sub Recorrer_Hojas()
' Recorrer_Hojas Macro
' Macro grabada el 19/03/2010 por Federico Rodriguez
Dim i As Integer, sCeldaActiva As String, sCeldaActivaTexto As String, sCeldaActivaC As String, sCA As String, m As Double, n As Double
i = 2
'For i = 2 To ThisWorkbook.Sheets.Count
     Sheets(i).Select
     [a2].Select
     sCA = ActiveCell.Value
     Do While Not (sCA = "")
         ActiveCell.Offset(1, 0).Select
         sCA = ActiveCell.Value
     Loop
     ActiveCell.Offset(-1, 0).Select
     sCeldaActiva = ActiveCell.Address
     [a3].Select
     sCeldaActivaTexto = ActiveCell.Value
     ActiveCell.Offset(1, 0).Select
     m = Range("A3", (sCeldaActiva)).Count
     On Error GoTo noencontro
     Dim m0 As Range, sbusi As String, sbusf As String
     For iBuscado = 0 To m
        sbusi = ActiveCell.Address
        Set m0 = Range(ActiveCell.Address, sCeldaActiva).Find(What:=sCeldaActivaTexto)
        If m0 Is Nothing Then
            MsgBox "No encontre nada"
        Else
            Range(Cells(m0.Row, 1), Cells(m0.Row, 9)).Delete (xlShiftUp)
            'Set m1 = Range("a3", sCeldaActiva).Find(What:=sCeldaActivaTexto)
            'If m1 Is Nothing Then
            'Else
            '    Range(Cells(m1.Row, 1), Cells(m1.Row, 9)).Delete (xlShiftUp)
            'End If
        End If
        Cells.FindNext(After:=ActiveCell).Activate
        'ActiveCell.Offset(0, -2).Select
        Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 9)).Select '.Delete (xlShiftUp)
        With Selection.Interior
            .ColorIndex = 34
            .Pattern = xlSolid
        End With
        'ActiveCell.Offset(1, 0).Select
        sCeldaActivaTexto = ActiveCell.Value
        sbusf = ActiveCell.Address
        If sbusi = sbusf Then
            ActiveCell.Offset(1, 0).Select
        End If
     Next

noencontro:

'Next
End Sub

'
'
vale aclarar que esta pensado para recorrer varias hojas.. pero para la prueba esta hecho sobre la hoja 2