Ho bisogno di una macro veloce excel vba che elimina each row con un 0 nella colonna A

Adesso sto usando la macro sotto per eliminare each row con una colonna 0 nella colonna A. Il problema è che è troppo lento. Ci sono voluti circa trenta secondi per fare il lavoro per duemila righe, ma ho bisogno di una macro per lavorare su 300.000 righe. La macro corrente blocca il mio computer con molte righe. Ho provato le prime cinque soluzioni su questo sito senza fortuna: http://www.dummies.com/software/microsoft-office/excel/10-ways-to-speed-up-your-macros/

Sub Loop_Example() Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long Dim ViewMode As Long With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With 'We use the ActiveSheet but you can replace this with 'Sheets("MySheet")if you want With ActiveSheet 'We select the sheet so we can change the window view .Select 'If you are in Page Break Preview Or Page Layout view go 'back to normal view, we do this for speed ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView 'Turn off Page Breaks, we do this for speed .DisplayPageBreaks = False 'Set the first and last row to loop through Firstrow = .UsedRange.Cells(1).Row Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row 'We loop from Lastrow to Firstrow (bottom to top) For Lrow = Lastrow To Firstrow Step -1 'We check the values in the A column in this example With .Cells(Lrow, "A") If Not IsError(.Value) Then If .Value = "0" Then .EntireRow.Delete 'This will delete each row with the Value "ron" 'in Column A, case sensitive. End If End With Next Lrow End With ActiveWindow.View = ViewMode With Application .ScreenUpdating = True .Calculation = CalcMode End With End Sub 

Non posso commentare se questo è il modo più veloce, ma è probabilmente il più breve in termini di codice reale che troverai su queste risposte:

 'get number of cells in A column Dim x as long: x = WorksheetFunction.CountA(ActiveSheet.Range("A:A")) 'AutoFilter to pick up only zeroes ActiveSheet.Range("$A$1:$Z" & x).AutoFilter Field:=1, Criteria1:=0 'delete what is currently filtered ActiveSheet.Rows("2:" & x).Delete Shift:= xlUp 

EDIT:

 ActiveSheet.Range("$A$1:$Z" & x).AutoFilter 

– a questo fine si spegne l'autofilter

L'autofilter qui è ordinare per colonna A (field 1 in A: Z) e cercare gli zero (Criteri: = 0) – potrebbe essere necessario adattare leggermente per i tuoi scopi, ma è abbastanza semplice

nota: Questo richiede un po 'di tempo con 300.000 + righe – ho una routine che estrae circa 200.000 + righe da un set di dati come questo su base bimestrale. Che probabilmente sembra pazzo, ad exception che sto solo utilizzando quei dati per riassumere in una tabella pivot – una volta che è stato aggiornato, la maggior parte dei dati può andare.

Non leggere 1-per-1. Eliminare tutti in una volta.

 Sub Loop_Example() Dim Firstrow As Long Dim Lastrow As Long Dim Lrow As Long Dim CalcMode As Long Dim ViewMode As Long Dim Data As Variant Dim DelRange As Range With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With 'We use the ActiveSheet but you can replace this with 'Sheets("MySheet")if you want With ActiveSheet 'We select the sheet so we can change the window view .Select 'If you are in Page Break Preview Or Page Layout view go 'back to normal view, we do this for speed ViewMode = ActiveWindow.View ActiveWindow.View = xlNormalView 'Turn off Page Breaks, we do this for speed .DisplayPageBreaks = False 'Set the first and last row to loop through Firstrow = .UsedRange.Cells(1).Row Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row Data = .Range("A1:A" & Lastrow) 'We loop from Lastrow to Firstrow (bottom to top) For Lrow = Lastrow To Firstrow Step -1 If Not IsError(Data(Lrow, 1)) And Not IsEmpty(Data(Lrow, 1)) Then If Data(Lrow, 1) = 0 Then If DelRange Is Nothing Then Set DelRange = .Rows(Lrow) Else Set DelRange = Union(DelRange, .Rows(Lrow)) End If End If End If Next Lrow DelRange.Delete End With ActiveWindow.View = ViewMode With Application .ScreenUpdating = True .Calculation = CalcMode End With End Sub 

Forse usando qualcosa del genere

  Sub DeleteZeroRows() Dim a() As Variant Dim l As Long a = Range("a1:a300000").Value For l = UBound(a) To 1 Step -1 If a(l, 1) = 0 Then Debug.Print "Row " & l & " delete" Rows(l).EntireRow.Delete End If Next l End Sub 

Se i dati non contengono formule, allora il refactoring potrebbe barare forse da 10 a 15 secondi dal tempo di esecuzione.

immettere qui la descrizione dell'immagine


 Sub DeleteRows() Const PageSize As Long = 20000 Dim rw As Range Dim Data Dim lStart As Long, lEnd As Long, lNextRow As Long Dim list As Object: Set list = CreateObject("System.Collections.ArrayList") ToggleEvents False MonitorTimes True With Worksheets("Sheet1").UsedRange For Each rw In .Rows If Not IsError(rw.Cells(1).Value) Then If rw.Cells(1).Value <> 0 Then list.Add rw.Formula End If Next MonitorTimes .Cells.ClearContents For lStart = 0 To list.Count Step PageSize lEnd = IIf(lStart + PageSize - 1 <= list.Count, PageSize, list.Count - lStart) Data = Application.Transpose(list.GetRange(lStart, lEnd).ToArray) Data = Application.Transpose(Data) With .Range("A1").Offset(lNextRow) .Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data lNextRow = lNextRow + PageSize End With Next End With MonitorTimes ToggleEvents True End Sub Static Sub ToggleEvents(EnableEvents As Boolean) Dim CalcMode As Long If EnableEvents Then With Application CalcMode = .Calculation .Calculation = xlCalculationManual .ScreenUpdating = False End With Else With Application .ScreenUpdating = True .Calculation = CalcMode End With End If End Sub Static Sub MonitorTimes(Optional ResetVariables As Boolean) Dim tLoad, Start Dim RowCount As Long, ColumnCount As Long If ResetVariables Then Start = 0 tLoad = 0 End If With Worksheets("Sheet1") If Start = 0 Then Start = Timer Debug.Print "Before: "; "Rows->"; WorksheetFunction.CountA(.Columns(1)); "Columns->"; WorksheetFunction.CountA(.Rows(1)) ElseIf tLoad = 0 Then tLoad = Timer - Start Else Debug.Print "After: "; "Rows->"; WorksheetFunction.CountA(.Columns(1)); "Columns->"; WorksheetFunction.CountA(.Rows(1)) Debug.Print "Load Time in Second(s): "; tLoad Debug.Print "Write Time in Second(s): "; Timer - Start - tLoad Debug.Print "Execution Time in Second(s): "; Timer - Start End If End With End Sub Sub RestoreTestData() Worksheets("Original").Cells.Copy Worksheets("Sheet1").Cells ThisWorkbook.Save End Sub