EXCEL VBA- Borrar filas masivamente

[uka]

Hola y gracias anticipadas:

Actualmente estoy borrando de listados aquellas líneas que no me interesan con el siguiente ejemplo.
Borro las líneas 0 de la 5ª columna , pero al borrar otros valores en 30.000 líneas se me hace eterno. Estoy buscando la forma de seleccionar todas las líneas que contengan "0" y borrar todas las líneas juntas.

'Borro las lineas con valor = 0

lrow = 1
Do Until Cells(lrow, 5) = ""
If Cells(lrow, 5) = "0" Then
Rows(lrow).Select
Selection.Delete Shift:=xlUp
lrow = lrow - 1
End If
lrow = lrow + 1
Loop

He visto que para borrar filas en blanco se puede usar el ejemplo abajo indicado pero no sé como modificarlo para mi ejemplo.

Sub DeleteEmptyRows()
Dim LastRow As Long
Dim r As Long
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.WorksheetFunction.CountA(Rows(r)) = 0 _
Then Rows(r).Delete
Next r
End Sub

Saludos

UKA

[David]

La segunda función hace básicamente la misma cosa que la tuya, el secreto está en esto:

Código PHP:

  Application.ScreenUpdating = False 
   

Lo que hace es desactivar el repintado de la pantalla con lo que el proceso de borrado es mucho más rápido.

[mrocf]

Hola! Uka.
Este procedimiento elimina 600 filas de un total de 10.000 en 2 segundos. Su velocidad se debe a que elimina de a 50 filas simultáneamente.

Código:

Sub BorrarFilasMasivamente()
Application.ScreenUpdating = False
timecalc = Time
msg = "Se eliminaron " & WorksheetFunction.CountIf([E:E], "0") & _
  " filas de un total de " & WorksheetFunction.Count([E:E]) & " en "

For ii = [E1].End(xlDown).Row To 1 Step -1
  If Cells(ii, [E1].Column) = "0" Then
    Conj = Conj & "," & "E" & ii
    If Len(Conj) > 248 Then
      Range(Right(Conj, Len(Conj) - 1)).EntireRow.Delete: Conj = Empty
    End If
  End If
Next ii

If Conj <> Empty Then Range(Right(Conj, Len(Conj) - 1)).EntireRow.Delete

Application.ScreenUpdating = True
MsgBox msg & Format(Time - timecalc, "s") & " segundos."
End Sub

Saludos

[uka]

Hola David el Grande.

Gracias por tu consejo, lo he incluido en alguna parte del código y sí, me ahorro esos parpadeos molestos.

LUIS

[uka]

Hola mrocf:

Gracias, ha ido genial. He recordado unos segundos muy valiosos...

Abusando un poco más, sería difícil modificar el código para que sea inverso osea que borre todo menos las que sean 0.

Gracias.


UKA

[mrocf]

Podrías aplicar una de estas dos alternativas:

1º) Reemplazar la línea:
If Cells(ii, [E1].Column) = "0" Then

por la línea:
If Cells(ii, [E1].Column) <> "0" Then

2º) O, mejor aún: utilizas este otro procedimiento mucho más eficiente puesto que se basa en filtrar la columna "E":

Código:

Sub BorrarFilasMasivamenteMasRapido()
Application.ScreenUpdating = False
Set MiRango = Range([E2], [E65536].End(xlUp))
  If ActiveSheet.AutoFilterMode Then ActiveSheet.AutoFilterMode = False
  [E:E].AutoFilter
  [E:E].AutoFilter Field:=1, Criteria1:="<>0"
  MiRango.EntireRow.Delete
  [E:E].AutoFilter
If [E1] <> 0 Then [1:1].Delete
Set MiRango = Nothing
Application.ScreenUpdating = True
End Sub

Espero que te sean útiles.

Saludos

[uka]

Hola mrocf:

Gracias, lamento haberte hecho perder el tiempo, era evidente la primera respuesta . La he provado y funciona.

Sobre el otro procediento parace increible que sea más eficiciente que el anterior código, ya he ahorrado el tiempo suficiente.

Saludos

[mrocf]

Fue un gusto, y hasta la próxima.