Question

我想根据我感兴趣的4列中的一列是否大于0来复制整行。我是VBA的新手，并尝试了以下代码，但它似乎不起作用。

Sub MyViewCopy()
    Set sh = Sheets("XyNewSheet")
    RowCount = 0
    lr2 = 0
    For Each rw In sh.Rows
        If (
       (Cells(rw.Row, 10).Value > 0) Or (Cells(rw.Row, 12).Value > 0) 
        Or 
       (Cells(rw.Row, 14).Value > 0) Or (Cells(rw.Row, 16).Value > 0) 
       Or 
       (Cells(rw.Row, 18).Value > 0)
       ) Then
       Rows(rw).Copy Destination:=Sheets("MyView").Range("A" & lr2 + 1)
       lr2 = Sheets("MyView").Cells(Rows.Count, "A").End(xlUp).Row

       RowCount = RowCount + 1
    End If
    Next rw
    MsgBox (RowCount)
End Sub

Answer 1

尝试使用J，L，N，P和R列中的实际值减少检查到的行。

Option Explicit

Sub MyViewCopy()
    Dim r As Long, rc As Long, mxr As Long

    With Worksheets("XyNewSheet")
        mxr = Application.Max(.Cells(.Rows.Count, "J").End(xlUp).Row, _
                              .Cells(.Rows.Count, "L").End(xlUp).Row, _
                              .Cells(.Rows.Count, "N").End(xlUp).Row, _
                              .Cells(.Rows.Count, "P").End(xlUp).Row, _
                              .Cells(.Rows.Count, "R").End(xlUp).Row)
        For r = 1 To mxr
            If .Cells(r, "J").Value2 > 0 Or .Cells(r, "L").Value2 > 0 Or _
               .Cells(r, "N").Value2 > 0 Or .Cells(r, "P").Value2 > 0 Or _
               .Cells(r, "R").Value2 > 0 Then
                .Rows(r).Copy Destination:=Worksheets("MyView").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                rc = rc + 1
            End If
        Next r
    End With

    MsgBox (rc)
End Sub

您对Or声明的包围是不必要的。只有在你想要将And和Or的组合组合在一起时才有必要。

根据几个条件将特定行从一个工作表复制到另一个工作表

1 个答案: