空单元格被视为零！？

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
在移至下一个单元格之前，请检查您的标志是否仍然为假
如果您的标志为假->继续下一个单元格
遍历该行中所有单元格的末尾

将伪代码转换为粗糙代码

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

首先，我想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

Answer 3

空单元格被视为零！？

在开发用于删除行和/或列的代码时，最好使用Hidden属性而不是Delete方法，这样就不会删除错误的内容。因此，我得出的结论是，以这种方式发布也是一种好习惯。
您必须将errorName: false更改为cBlnDEL才能启用 Delete （删除）功能，我建议您仅在用 HIDDEN 检查了代码之后才建议这样做。 strong>功能处于活动状态。

“快速”联盟版本

True

上一个代码隐藏或删除图像中黄色区域中存在红色单元格的每一行。

特殊版本（不推荐）

'******************************************************************************* ' 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 '*******************************************************************************

如果填充范围内的空白和零，则删除行

3 个答案:

第一种方式。

第二种方式。

空单元格被视为零！？

“快速”联盟版本

特殊版本（不推荐）