Question

我正在尝试编写一个代码，它基本上会查看第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

Answer 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

您之前的问题没有提及公式的存在。

如果某个范围内的所有基于公式的单元格都为0或空白

1 个答案: