首页 文章

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

提问于
浏览 次
0

我正在尝试编写一个代码，基本上查看行13-33并删除整行，如果列B-M中的单元格都是空白而且列A不是空白 . 我遇到的问题是我的所有单元格都引用了另一个工作表中的值（基于公式） . 当我在下面运行我的代码时，它似乎并不认为这些基于公式的单元格为“0”，即使它有 Value .

它只删除有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
excel vba excel-vba

1 回答

  • 0

    根据我对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

    您之前的问题没有提到公式的存在 .

    回复于

相关问题