如果某个范围内所有基于公式的单元格为 0 或空白，则删除行答案

【问题标题】：Delete row if all formula-based cells in a certain range are 0 or blank如果某个范围内所有基于公式的单元格为 0 或空白，则删除行
【发布时间】：2018-04-15 12:41:07
【问题描述】：

我正在尝试编写一个基本上查看第 13-33 行的代码，如果 B-M 列中的单元格全部为空白且 A 列不为空白，则删除整行。我遇到的问题是我的所有单元格都引用了另一张表中的值（基于公式）。当我在下面运行我的代码时，它似乎没有将这些基于公式的单元格识别为“0”，即使那是有价值的。

它只删除包含 0 但不引用另一个单元格的行。我不想在运行之前将所有内容复制并粘贴为值，因为我希望能够保留公式。

请看下面，并建议我如何做到这一点。

Sub ScheduleB()
    On Error GoTo errHandler

    Const TOP_ROW As Long = 13
    Const BOTTOM_ROW As Long = 33

    Dim rowIndex As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook.Worksheets("Schedule A Template")
        For rowIndex = .Cells(BOTTOM_ROW, "A").End(xlUp).Row To TOP_ROW Step -1
            If Not IsEmpty(.Cells(rowIndex, "A").Value2) Then '...column A is not blank.
                If Application.WorksheetFunction.CountA(.Range(.Cells(rowIndex, "B"), .Cells(rowIndex, "M"))) = 0 Then '...all cells on row rowIndex from columns B to M are blank.
                    .Rows(rowIndex).Delete Shift:=xlUp
                End If
            End If
        Next
    End With

Cleanup:
    On Error Resume Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub

errHandler:
    MsgBox Err.Description, vbExclamation + vbOKOnly, "Error"
    Resume Cleanup
End Sub

【问题讨论】：

尝试检查 "" 而不是 0

标签： vba excel

【解决方案1】：

根据我对您的preceding question 的回答，您可以扫描每行的 B 到 M 单元格并决定是否要删除该行。

Sub ScheduleB()
    On Error GoTo errHandler

    Const TOP_ROW As Long = 13
    Const BOTTOM_ROW As Long = 33

    Dim rowIndex As Long
    Dim cell As Excel.Range
    Dim bDelete As Boolean

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook.Worksheets("Schedule A Template")
        For rowIndex = .Cells(BOTTOM_ROW, "A").End(xlUp).Row To TOP_ROW Step -1
            If Not IsEmpty(.Cells(rowIndex, "A").Value2) Then '...column A is not blank.
                bDelete = True

                For Each cell In .Range(.Cells(rowIndex, "B"), .Cells(rowIndex, "M")).Cells
                    If Not IsEmpty(cell.Value2) Then
                        If VarType(cell.Value2) = vbDouble Then
                            If cell.Value2 <> 0 Then
                                bDelete = False 'Not deleting because a numeric value is non-zero.
                            End If
                        Else
                            bDelete = False 'Not deleting because we've hit a non-blank, non-numeric value, such as a string or an error.
                        End If
                    End If

                    If Not bDelete Then
                        Exit For
                    End If
                Next

                If bDelete Then
                    '.Rows(rowIndex).Delete Shift:=xlUp
                Else
                    Debug.Print "will not delete row " & CStr(rowIndex)
                End If
            End If
        Next
    End With

Cleanup:
    On Error Resume Next
    Set cell = Nothing
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Exit Sub

errHandler:
    MsgBox Err.Description, vbExclamation + vbOKOnly, "Error"
    Resume Cleanup
End Sub

你前面的问题没有提到公式的存在。

【讨论】：