如果在一个范围内填充了空白和零，则删除行

Question

我有一份报告，我需要删除单元格中没有数据的行或 C 到 O 列范围内的零行。

这段代码我几乎完美地完成了，但是我发现了一个致命的逻辑缺陷。如果该行具有总和为零的正值和负值，它将被删除，而我仍然需要保留该行。

我真的很感谢这个网站的帮助，因为我已经能够真正自动化我的许多报告并帮助其他部门的人！你们真棒！谢谢！

Dim rw As Long, i As Long
rw = Cells(Rows.Count, 1).End(xlUp).Row
For i = rw To 6 Step -1
If Application.Sum(Cells(i, 3).Resize(1, 17)) = 0 Then
Rows(i).Delete
End If
Next

Answer 1

与其检查 SUM，不如遍历每个单元格并检查其是否有效。

为了更好地解释这一点，我将为您使用伪代码：

创建一个标志变量并将其设置为 false
创建一个循环来检查一行中的每个单元格
如果找到有效数字，则将标志设置为 true
在移动到下一个单元格之前，请检查您的标记是否仍然为 false
如果您的标记为假 -> 继续下一个单元格
循环到行中所有单元格的末尾

伪代码制作成粗略的代码

Dim rw As Long, i As Long
Dim rng As Range
Dim validRow As Boolean
validRow = false

rw = Cells(Rows.Count, 1).End(xlUp).Row

For i = rw To 6 Step -1
    Set rng = (Cells(i, 3).Resize(1, 17))
    For Each cell In rng
         If Not IsEmpty(cell) Then
            If cell.value <> 0 Then
               validRow = true
            End If
         End If
         If validRow = true Then
        Exit For
         End If
    Next cell
    If validRow = false Then
        Rows(i).Delete
    End If
    validRow = false
Next

[@LL 编辑：将 >0 更改为 <>0 也寻找与零不同的任何内容，以说明仅填充负值的行]

Answer 2

空单元格被视为零！？

开发用于删除行 and/or 列的代码时，最好使用隐藏属性而不是 Delete 方法，这样就不会删除错误的内容。因此，我得出结论，以这种方式 post 也是一种很好的做法。
您必须将 cBlnDEL 更改为 True 以启用 DELETE 功能，我建议您仅在使用 [=27 检查代码后才这样做=]HIDDEN 功能激活。

A 'Fast'联盟版

'*******************************************************************************
' Purpose:    Deletes or hides empty rows, and rows containing zero (0) in     *
'             a specified range, in the ActiveSheet (of the ActiveWorkbook).   *
'*******************************************************************************
Sub DeleteBlankAndZeroRows()

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  Const Col1 As Integer = 3         ' First Column of Source Range
  Const Col2 As Integer = 13        ' Last Column of Source Range
  Const Row1 As Integer = 6         ' First Row of Source Range
  Const cBlnDEL As Boolean = False  ' If True, Delete. If False, Hide.

  Dim rng As Range                  ' Check Range
  Dim rngU As Range                 ' Target Union Range

  Dim Row2 As Long                  ' Last Row of Source Range
  Dim i As Long                     ' Source Range Rows Counter
  Dim j As Long                     ' Source Range Columns Counter
  Dim k As Long                     ' Deleted Rows Counter
  Dim strMsg As String              ' Msgbox Text

  On Error GoTo ErrorHandler

  With ActiveWorkbook.ActiveSheet ' A reminder of where this is happening.
    ' Calculate last row of Source Range.
    Row2 = .Cells(.Rows.Count, 1).End(xlUp).Row
    ' Set bogus reference to "aquire range level" (Parent).
    Set rng = .Cells(1, 1)
  End With

  ' Loop through each row in Source Range.
  For i = Row1 To Row2

    ' Calculate the Check Range for current row in Source Range.
    Set rng = rng.Parent.Cells(i, Col1).Resize(1, Col2)

    ' If the cell at the intersection of column Col1 and the current row
    ' is 0, add it to the Target Union Range.
    ' Note: Unexpectedly, the value of an empty cell is treated as 0 here.

    ' Loop through each cell of the (one-row) Check Range.
    For j = 1 To rng.Columns.Count

      If rng.Cells(1, j).Value = 0 Then ' If 0 is found.
        k = k + 1                         ' Count to be deleted rows.
        If Not rngU Is Nothing Then       ' There already is a range in rngU.
          Set rngU = Union(rngU, rng.Cells(1, 1)) ' Add another.
         Else                             ' There is no range in rngU.
          Set rngU = rng.Cells(1, 1)              ' Add one.
        End If
        Exit For
'         Else                            ' If 0 is NOT found.
      End If

    Next ' (Cell in (one-row) Check Range)

  Next   ' (Row in Source Range)

  ' Note: If no 0 was found, the Target Union Range does NOT contain a range.

  If Not rngU Is Nothing Then ' Target Union Range contains range(s).
    If cBlnDEL Then ' DELETE is active. Delete Target Union Range.
      strMsg = "DeleteBlankAndZeroRows successfully deleted " & k _
          & " rows in " & rngU.Areas.Count & " areas."
      rngU.Rows.EntireRow.Delete
     Else           ' HIDDEN is active. Hide Target Union Range.
      strMsg = "DeleteBlankAndZeroRows has successfully hidden " & k _
          & " rows in " & rngU.Areas.Count & " areas."
      rngU.Rows.EntireRow.Hidden = True
    End If
   Else                       ' Target Union Range does NOT contain range(s).
    strMsg = "You may have used the DELETE feature of " _
        & "DeleteBlankAndZeroRows recently, because " _
        & " it could not find any zeros. Nothing deleted."
  End If

ProcedureExit:

  Set rngU = Nothing
  Set rng = Nothing

  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True

  MsgBox strMsg

Exit Sub

ErrorHandler:
  strMsg = "An unexpected error occurred. Error: " & Err.Number & vbCr _
      & Err.Description
  GoTo ProcedureExit

End Sub
'*******************************************************************************

前面的代码隐藏或删除了黄色区域中有红色单元格的每一行，如图所示。

特殊版本（不推荐）

Sub DelBlankAndZeroRowsDontKnowHowIGotOutOfMyBedThisAfternoonVersion()
  Dim rw As Long, i As Long, j As Long
  Dim rng As Range, rngU As Range
    rw = Cells(Rows.Count, 1).End(xlUp).Row
    For i = rw To 6 Step -1
      Set rng = Cells(i, 3).Resize(1, 13)
      For j = 1 To rng.Columns.Count
        If rng.Cells(1, j).Value = 0 Then
          If Not rngU Is Nothing Then
            Set rngU = Union(rng.Cells(1, 1), rngU)
           Else
            Set rngU = rng.Cells(1, j)
          End If
        End If
      Next
    Next
    rngU.Rows.Hidden = True
  Set rngU = Nothing
  Set rng = Nothing
End Sub

Sub DelBlankAndZeroRowsThinkImGonnaStayInBedTodayVersion()
Dim rw As Long, i As Long, j As Long
Dim rng As Range, rngU As Range
rw = Cells(Rows.Count, 1).End(xlUp).Row
For i = rw To 6 Step -1
Set rng = Cells(i, 3).Resize(1, 13)
For j = 1 To rng.Columns.Count
If rng.Cells(1, j).Value = 0 Then
If Not rngU Is Nothing Then
Set rngU = Union(rng.Cells(1, 1), rngU)
Else
Set rngU = rng.Cells(1, j)
End If
End If
Next
Next
rngU.Rows.Hidden = True
Set rngU = Nothing
Set rng = Nothing
End Sub

Sub DelBlankAndZeroRowsNeverGonnaGetUpVersion()
Dim rw As Long, i As Long, j As Long, rng As Range, rngU As Range
rw = Cells(Rows.Count, 1).End(xlUp).Row: For i = rw To 6 Step -1
Set rng = Cells(i, 3).Resize(1, 13): For j = 1 To rng.Columns.Count
If rng.Cells(1, j).Value = 0 Then
If Not rngU Is Nothing Then
Set rngU = Union(rng.Cells(1, 1), rngU)
Else: Set rngU = rng.Cells(1, j): End If: End If: Next: Next
rngU.Rows.Hidden = True: Set rngU = Nothing: Set rng = Nothing: End Sub

Answer 3

首先，我想，Resize 中有错误 - 它应该是 13 - 而不是 17。其次，如果要删除大量数据，可以使用 AutoFilter.

第一种方式。

正在更改您的代码：

Sub FFF()
    Dim rw As Long, i As Long, cntZeroes%, cntEmpty%
    rw = Cells(Rows.Count, 1).End(xlUp).Row
    For i = rw To 6 Step -1
        With Cells(i, 3).Resize(, 13)
            cntZeroes = Application.CountIf(.Cells, 0)
            cntEmpty = Application.CountIf(.Cells, vbNullString)
            If cntZeroes = 13 Or cntEmpty = 13 Then Rows(i).Delete
        End With
    Next
End Sub

第二种方式。

将辅助列 P（因为它在 O 旁边）与 AutoFilter 一起使用。比较复杂，但是比逐行删除要快：

Sub FFF2()
    Dim rw As Long, i As Long, cntZeroes%, cntEmpty%
    rw = Cells(Rows.Count, 1).End(xlUp).Row
    For i = rw To 6 Step -1
        With Cells(i, 3).Resize(, 13)
            cntZeroes = Application.CountIf(.Cells, 0)
            cntEmpty = Application.CountIf(.Cells, vbNullString)
            If cntZeroes = 13 Or cntEmpty = 13 Then
                Cells(i, "P") = 1
            End If
        End With
    Next
    With Rows(5)
        .AutoFilter Field:=16, Criteria1:=1
        On Error Resume Next
        With .Parent.AutoFilter.Range
            .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
        On Error GoTo 0
        .Parent.AutoFilterMode = False
    End With

End Sub

如果在一个范围内填充了空白和零，则删除行

Delete Row if populated with blanks and zeros within a range

excel

vba

delete-row

空单元格被视为零！？

A 'Fast'联盟版

特殊版本（不推荐）

第一种方式。

第二种方式。