当rows = 0时,删除Excel列中的单元格

我试图删除电子表格中列中的所有单元格= 0,并且“召唤”那些不在列顶部的值。

我目前正在使用

Dim row_index As Integer Dim col_index As Integer row_index = 7 col_index = 16 Application.ScreenUpdating = False 'turns off screen updates While Cells(row_index, col_index) <> "" If Cells(row_index, col_index) = 0 Then Cells(row_index, col_index).Delete Else row_index = row_index + 1 End If Wend Application.ScreenUpdating = True 'turns screen updates back on 

但即使屏幕更新,数据集在500-3500点之间也是非常慢的。 有没有更好的方法来做到这一点或任何其他提示,以加快?

谢谢

编辑:在网上有几个解决scheme,但他们似乎都涉及消隐单元格或删除 。 我只想删除单元格,然后将单元格向上移动。

在循环中删除单元格可能非常慢。 你可以做的是确定你想在一个循环中删除的单元格,然后在循环之后一次删除它们。 尝试这个。

 Option Explicit Sub Sample() Dim row_index As Long, lRow As Long, i As Long Dim ws As Worksheet Dim delRange As Range '~~> Change this to the relevant worksheet Set ws = ThisWorkbook.Sheets("Sheet1") row_index = 7 Application.ScreenUpdating = False With ws lRow = .Range("P" & .Rows.Count).End(xlUp).Row For i = row_index To lRow If .Range("P" & i).Value <> "" And .Range("P" & i).Value = 0 Then If delRange Is Nothing Then Set delRange = .Range("P" & i) Else Set delRange = Union(delRange, .Range("P" & i)) End If End If Next End With If Not delRange Is Nothing Then delRange.Delete shift:=xlUp Application.ScreenUpdating = True End Sub 

自动过滤解决scheme

 Dim rng1 As Range Set rng1 = Range([p7], Cells(Rows.Count, "p").End(xlUp)) ActiveSheet.AutoFilterMode = False With rng1 .AutoFilter Field:=1, Criteria1:="0" .Delete xlUp End With 

要加快速度,您可能还想在更新时closures自动计算:

 Application.Calculation = xlCalculationManual 

然后在完成后将其更改回自动:

 Application.Calculation = xlCalculationAutomatic 

就在这里:

 Sub DoMAcro() Dim lastRow As Integer lastRow = Cells(1000, 16).End(xlUp).Row Range(Cells(7, 16), Cells(lastRow, 16)).Replace What:="0", Replacement:="", LookAt:=xlPart, _ SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False End Sub