根据条件复制表中的行答案

【问题标题】：Copy rows in a table based on criteria根据条件复制表中的行
【发布时间】：2020-11-03 21:09:35
【问题描述】：

我有一个带有值的 excel 表。我正在尝试使用 VBA：

Col 0 被复制到一个工作表的行
Col = 0 的行被复制到另一个工作表

我的代码来自下面，taken from here。但是在下面，我只能复制 1，而不是复制 2 中指定条件的行。

Sub ExportData()

Dim rngJ As Range
Dim MySel As Range

Set rngJ = Range("O1", Range("O" & Rows.Count).End(xlUp))
Set wsNew = ThisWorkbook.Worksheets.Add

For Each cell In rngJ
    If cell.Value <> 0 Then
        If MySel Is Nothing Then
            Set MySel = cell.EntireRow
        Else
            Set MySel = Union(MySel, cell.EntireRow)
        End If
    End If
Next cell

If Not MySel Is Nothing Then MySel.Copy Destination:=wsNew.Range("A1")

End Sub

【问题讨论】：

标签： excel vba

【解决方案1】：

您可以引入Elseif 语句和第二个范围：

Sub ExportData()

Dim rngJ As Range
Dim MySel_1 As Range
Dim MySel_2 As Range

Set rngJ = Range("O1", Range("O" & Rows.Count).End(xlUp))
Set wsNew_1 = ThisWorkbook.Worksheets.Add
Set wsNew_2 = ThisWorkbook.Worksheets.Add

For Each cell In rngJ
    If cell.Value <> 0 Then
        If MySel_1 Is Nothing Then
            Set MySel_1 = cell.EntireRow
        Else
            Set MySel_1 = Union(MySel_1, cell.EntireRow)
        End If
    ElseIf cell.Value = 0 Then
        If MySel_2 Is Nothing Then
            Set MySel_2 = cell.EntireRow
        Else
            Set MySel_2 = Union(MySel_2, cell.EntireRow)
        End If
    End If
Next cell

If Not MySel_1 Is Nothing And Not MySel_2 Is Nothing Then
    MySel_1.Copy Destination:=wsNew_1.Range("A1")
    MySel_2.Copy Destination:=wsNew_2.Range("A1")
End If

End Sub

【讨论】：