我需要一个更快的excel vba宏来删除A列中的每一行0

Question

现在，我正在使用下面的宏删除A列中的每一行。问题是它太慢了。花了大约30秒来完成两千行的工作，但我需要一个宏来处理300,000行。当前的宏冻结了我的计算机那么多行。我在这个网站上尝试了前五个解决方案但没有运气：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

Answer 1

我无法评论这是否是最快的方式，但就您在这些答案中找到的实际代码而言，它可能是最短的：

@RunWith(MockitoJUnitRunner.class)
public class ClassificationControllerTest {

@Mock
private IClassificationService classificationService;

@Before
public void setUp() {
    mockMvc = MockMvcBuilders.standaloneSetup(new ClassificationController(classificationService)).build();
}

@Test
public void createCategoryTest() throws Exception {
    String jsonTask = String.format("{\"id\": \"2\",\"categoryName\": \"Category Name 2\"}");
    MvcResult result = mockMvc.perform(post("/category")
            .contentType(MediaType.APPLICATION_JSON_UTF8)
            .content(jsonTask))
            .andDo(MockMvcResultHandlers.print())
            .andExpect(content().contentType(MediaType.APPLICATION_JSON_UTF8))
            .andExpect(content().string(containsString("\"id\":2")))
            .andExpect(content().string(containsString("\"categoryName\":\"Category Name 2\"")))
            .andExpect(status().isCreated())
            .andReturn();
}

编辑：

'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

- 在最后添加此功能后会关闭自动过滤器

此处的自动过滤器按A列排序（A：Z中的字段1）并查找零（标准：= 0） - 可能需要稍微调整以适合您的目的，但它很简单

注意：这确实需要一段时间才有300,000 +行 - 我有一个例行程序，每两周从这样的数据集中取出大约200,000 +行。这可能听起来很疯狂，除了我只使用这些数据在数据透视表中汇总它 - 一旦刷新了，大部分数据就可以了。

Answer 2

也许使用这样的东西

 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

Answer 3

不要一读一读。一次删除所有。

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

Answer 4

如果数据不包含任何公式，那么重构可能会比执行时间缩短10到15秒。

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