Vba 代码用于复制索引为 for 循环的所有行,其中 i 基于 if 条件



我在下面的VBA代码中遇到了问题,我的要求是从一张工作表中复制一些行并将其粘贴到另一个工作表中,但这些行基于条件,我下面的代码只复制满足条件的最后一行,所以请帮助我编写代码或建议不同的方法来做同样的事情。

Lastrow = Cells(Rows.Count, "B").End(xlUp).Row
For i = 1 To Lastrow
    If IsNumeric(Range("B" & i)) = True And IsEmpty(Range("B" & i)) = False And Range("B" & i) <> 0 Then
        Range("B" & i).Select
        Row(i).Copy
        'For j = i To Lastrow
        '    If IsNumeric(Range("C" & j)) = True And IsEmpty(Range("C" & j)) = False And Range("C" & j) <> 0 Then
        '        MsgBox (j)
        '    End If
        'Next j
    End If
Next i

在上面提到的代码中,我希望该代码选择并复制满足条件的每个 I 行索引,而不仅仅是满足条件的最后一行索引。

为了

复制满足条件的所有单元格,您可以定义一个Range对象,在我的代码中它是CopyRng,并且每次满足条件时,您都使用 Union 函数将当前单元格添加到CopyRng

因此,最后,您可以使用复制满足条件的所有单元格 CopyRng.Copy .

法典

Dim CopyRng As Range
With Sheets("Sheet1") '<-- modify "Sheet1" to your sheet's name
    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
    For i = 1 To LastRow
        If IsNumeric(.Range("B" & i)) And Trim(.Range("B" & i).Value) <> "" And .Range("B" & i).Value <> 0 Then
            If Not CopyRng Is Nothing Then
                Set CopyRng = Application.Union(CopyRng, .Range("B" & i))
            Else
                Set CopyRng = .Range("B" & i)
            End If
        End If
    Next i
    CopyRng.Copy
End With

编辑 1:复制满足条件的整行(仅修改内部If部分)

If Not CopyRng Is Nothing Then
    Set CopyRng = Application.Union(CopyRng, .Rows(i))
Else
    Set CopyRng = .Rows(i)
End If

最新更新