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

时间:2013-11-19 17:23:10

标签: excel excel-vba vba

我正在尝试删除电子表格中一列中的所有单元格= 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点之间。 有没有更好的方法来做到这一点或任何其他提示加快它?

由于

编辑:网上有一些解决方案,但它们似乎都涉及消隐单元格或删除。我只想删除单元格,然后向上移动单元格。

4 个答案:

答案 0 :(得分:8)

在循环中删除单元格确实非常慢。您可以做的是在循环中识别要删除的单元格,然后在循环后一次删除它们。试试这个。

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

答案 1 :(得分:2)

自动过滤解决方案

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

答案 2 :(得分:-1)

为了加快速度,您可能还希望在执行更新时关闭自动计算:

Application.Calculation = xlCalculationManual

完成后再将其更改为自动:

Application.Calculation = xlCalculationAutomatic

答案 3 :(得分:-2)

是的,有:

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