删除单元格，如果它们包含0

Question

我想删除工作表上所有列中的某些单元格（如果它们包含0），然后向上移动所有数据。

我在不同的线程上发现了这个公式，并且由于某种原因它只适用于一个列（列p），并且仅用了一半。

希望你的专家可以提供帮助。

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

Answer 1

尝试以下代码。问题似乎是你的实际删除命令不在循环中，而是在最后。所以它只发生过一次。此外，Union（）是不必要的。

Sub Sample()

Dim lRow, i As Long
Dim ws As Worksheet
Dim delRange As Range
'~~> Change this to the relevant worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")

Application.ScreenUpdating = False

With ws
    lRow = .Range("P" & .Rows.Count).End(xlUp).Row
    For i = lRow To 7 Step -1
        If .Range("P" & i).Value <> "" And .Range("P" & i).Value = 0 Then
            .Range("P" & i).Delete shift:=xlUp
        End If
    Next
End With

Application.ScreenUpdating = True
End Sub

什么是联盟范围的.delete ......？

Answer 2

试试这个：

Sub ZeroKiller()
    Dim rKill As Range
    Set rKill = Nothing
    For Each r In ActiveSheet.UsedRange
        If r.Value = 0 And r.Value <> "" Then
            If rKill Is Nothing Then
                Set rKill = r
            Else
                Set rKill = Union(rKill, r)
            End If
        End If
    Next r

    If rKill Is Nothing Then
    Else
    rKill.Delete Shift:=xlUp
    End If
End Sub