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

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