varias - macro para limpiar celdas excel

Código más rápido para eliminar celdas a través de varias hojas de trabajo en excel

Question

Soy un principiante en VB y busqué en Google y revisé las respuestas. He escrito el siguiente ciclo para recorrer varias hojas de trabajo de Excel y eliminar filas donde las celdas contienen elementos específicos (N / A # N / A #).

Los datos en la hoja xl a limpiar son datos financieros con FECHA, ABIERTO. ALTO BAJO CERRAR. el número de filas puede ser significativo y el número de hojas de trabajo puede ser 2-300. Funciona, pero es muy lento y, a medida que estoy aprendiendo, agradecería cualquier ayuda sobre cómo puedo hacer que este código sea más rápido. Gracias.

 Sub DataDeleteStage1()
ScreenUpdating = False
Dim lrow As Long
Dim ws As Worksheet
Dim icntr As Long
For Each ws In ThisWorkbook.Worksheets
lrow = ws.Cells(Rows.CountLarge, "a").End(xlUp).Row
For icntr = lrow To 1 Step -1
If ws.Name <> "HEADER" Then
If ws.Cells(icntr, "B") = "#N/A N/A" And ws.Cells(icntr, "C") = "#N/A N/A" And ws.Cells(icntr, "D") = "#N/A N/A" And ws.Cells(icntr, "E") = "#N/A N/A" Then
ws.Rows(icntr).EntireRow.Delete
End If
End If
Next icntr
Next ws
End Sub

Answer 1

¿Qué tal esto?

Sub DeleteRows()
Dim ws As Worksheet
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "HEADER" Then
On Error Resume Next
ws.Columns("B:E").Replace "#N/A N/A", "=NA()"
ws.Columns("B:E").SpecialCells(xlCellTypeFormulas, 16).EntireRow.Delete
End If
Next ws
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Answer 2

Con AutoFilter y sin bucle en conjunto:

Sub DataDeleteStage1()
Dim ws As Worksheet
Dim lr As Integer
Application.ScreenUpdating = False
For Each ws In ThisWorkbook.Worksheets
With ws
lr = .Range("A" & .Rows.Count).End(xlUp).Row
If ws.Name <> "HEADER" Then
.UsedRange.AutoFilter Field:=2, Criteria1:="#N/A"
.UsedRange.AutoFilter Field:=3, Criteria1:="#N/A"
.UsedRange.AutoFilter Field:=4, Criteria1:="#N/A"
.UsedRange.AutoFilter Field:=5, Criteria1:="#N/A"
.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Delete shift:=xlUp
End If
End With
Next ws
Application.ScreenUpdating = True
End Sub

Probado este frente al enfoque de rango combinado en 300K filas - más rápido por minutos al hacer varias hojas.

Answer 3

Intente fusionar todos los Range que se van a eliminar en un objeto MergeRng , y luego simplemente elimínelo todo a la vez.

Código

Sub DataDeleteStage1()
ScreenUpdating = False
Dim lrow As Long
Dim ws As Worksheet
Dim icntr As Long
Dim MergeRng As Range
For Each ws In ThisWorkbook.Worksheets
With ws
lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For icntr = lrow To 1 Step -1
If .Name <> "HEADER" Then
If .Cells(icntr, "B") = "#N/A N/A" And .Cells(icntr, "C") = "#N/A N/A" And .Cells(icntr, "D") = "#N/A N/A" And .Cells(icntr, "E") = "#N/A N/A" Then
If Not MergeRng Is Nothing Then
Set MergeRng = Application.Union(MergeRng, .Rows(icntr))
Else
Set MergeRng = .Rows(icntr)
End If
End If
End If
Next icntr
'' Delete all rows at once
If Not MergeRng Is Nothing Then MergeRng.Delete
End With
Set MergeRng = Nothing '' reset range when changing worksheets
Next ws
End Sub

Answer 4

No he probado, pero prueba esto,

Sub DataDeleteStage1()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim lrow As Long
Dim ws As Worksheet
Dim icntr As Long
For Each ws In ThisWorkbook.Worksheets
lrow = ws.Cells(Rows.CountLarge, "a").End(xlUp).Row
If ws.Name <> "HEADER" Then
On Error Resume Next
Range("F1:F" & lrow).Formula = "=IF(SUMPRODUCT(--ISERROR(A1:E1))=5,NA(),"""")"
Range("F1:F" & lrow).SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete shift:=xlUp
Range("F1:F" & lrow).Clear
End If
Next ws
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 5

Puede hacer que su código se elimine solo una vez y no todas las veces. Para hacerlo así, intente lo siguiente:

Sub DataDeleteStage1()
Application.ScreenUpdating = False
Dim lrow As Long
Dim ws As Worksheet
Dim icntr As Long
Dim delRange As Range
For Each ws In ThisWorkbook.Worksheets
lrow = ws.Cells(Rows.CountLarge, "a").End(xlUp).Row
For icntr = lrow To 1 Step -1
If ws.Name <> "HEADER" Then
If ws.Cells(icntr, "B") = "#N/A N/A" And _
ws.Cells(icntr, "C") = "#N/A N/A" And _
ws.Cells(icntr, "D") = "#N/A N/A" And _
ws.Cells(icntr, "E") = "#N/A N/A" Then
If Not delRange Is Nothing Then
Set delRange = ws.Rows(icntr)
Else
Set delRange = Union(delRange, ws.Rows(icntr))
End If
End If
End If
Next icntr
If Not delRange Is Nothing Then delRange.Delete
Set delRange = Nothing
Next ws
End Sub

No lo he intentado, pero debería funcionar.