Question

这就是我已经拥有的，它在从范围中删除#N / As方面效果很好。我现在正在修改它以对包含0的单元格执行相同的操作。

  Sub DeleteErrorRows()
        Dim r As Range
        Set r = Range("B:B").SpecialCells(xlCellTypeConstants, 16).EntireRow
        r.Copy Sheets("Sheet2").Range("A1")
        r.Delete
    End Sub

谢谢：）

Answer 1

试试这个。它会自动过滤您的列，并保留源工作表中具有findMe值的行。您可以将其设置为0，如示例中所示，或者您想要的任何其他内容。它将这些行（标题行除外）复制到目标工作表，然后从源工作表中删除它们。

请注意，这也会找到目标工作表上的第一个空行，以便您可以多次运行它而不会覆盖已移动到目标工作表的内容。

Sub CopyThenDeleteRowsWithMatch()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim tgt As Worksheet
    Dim rng As Range
    Dim lastRow As Long
    Dim firstPasteRow As Long
    Dim findMe As String

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1")
    Set tgt = wb.Sheets("Sheet2")

    lastRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
    firstPasteRow = tgt.Range("B" & tgt.Rows.Count).End(xlUp).Row + 1
    findMe = "0"

    Set rng = ws.Range("B1:B" & lastRow)

    ' filter and delete all but header row
    With rng
        .AutoFilter Field:=1, Criteria1:="=" & findMe
        With .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow
            .Copy tgt.Range("A" & firstPasteRow)
            .Delete
        End With
    End With

    ' turn off the filters
    ActiveSheet.AutoFilterMode = False
End Sub

Answer 2

考虑：

Sub DeleteZeroRows()
        Dim r As Range, rTemp As Range, rB As Range
        Set rB = Intersect(Range("B:B"), ActiveSheet.UsedRange)
        Set r = Nothing
        For Each rTemp In rB
            If Not IsEmpty(rTemp) And rTemp.Value = 0 Then
                If r Is Nothing Then
                    Set r = rTemp
                Else
                    Set r = Union(r, rTemp)
                End If
            End If
        Next rTemp
        Set r = r.EntireRow
        r.Copy Sheets("Sheet2").Range("A1")
        r.Delete
End Sub

搜索列为0，复制到新工作表，删除行 - 需要帮助

2 个答案: