复制行到新的工作表 VBA

Question

我正在尝试编写一段脚本，如果Sheet 1的第一列的值大于或等于10，则将该行复制到Sheet 2。

Sub Macro1()

Cells(1, 1).Select
For i = 1 To ActiveCell.SpecialCells(xlLastCell).Row

    Cells(i, 1).Select

    If ActiveCell.Value >= 10 Then
        Rows(ActiveCell.Row).Select

        Rows(i & ":").Select
        Selection.Copy

        Sheets("Sheet2").Select
        ActiveSheet.Paste

        Sheets("Sheet1").Select

     End If

Next i

End Sub

- user1296160

Answer 1

这个答案和第一个答案相似，但有一些不同之处。以下是一些注意事项：

• 使用 for-each 循环遍历范围（虽然它不如使用变体数组快，但保持简单，并提供比 for 循环更好的速度）。
• 在值检查之前，您可能需要添加一个“如果 IsNumeric（cell）”检查。
• 不要使用 select - 您不需要它，这会浪费资源。
• 最好使用 A 中使用的最后一个单元格，而不是使用的范围。

这是代码：

Sub CopyRows()

Dim cell As Range
Dim lastRow As Long, i As Long

lastRow = Range("A" & Rows.Count).End(xlUp).Row
i = 1

For Each cell In Sheets(1).Range("A1:A" & lastRow)
    If cell.Value >= 10 Then
        cell.EntireRow.Copy Sheets(2).Cells(i, 1)
        i = i + 1
    End If
Next

End Sub

- Gaijinhunter

Answer 2

尝试这个：它会是最快的，因为它不依赖于选择，而是通过VBA直接操作数据。

Sub CopyRows()
    Dim r_src As Range, r_dst As Range

    ' Pick 1st row and column of table
    Set r_src = Sheets("Sheet1").Range("B4")
    Set r_dst = Sheets("Sheet2").Range("B4")

    Dim i As Integer, j As Integer
    Dim N_rows As Integer, N_cols As Integer

    'Find the size of the data
    N_rows = CountRows(r_src)
    N_cols = CountColumns(r_src)

    'Resize source range to entire table
    Set r_src = r_src.Resize(N_rows, N_cols)

    Dim src_vals() As Variant, dst_vals() As Variant
    'Get all the values from source
    src_vals = r_src.Value2

    ReDim dst_vals(1 To N_rows, 1 To N_cols)
    Dim k As Integer
    k = 0
    For i = 1 To N_rows
        ' Check first column
        If Val(src_vals(i, 1)) >= 10 Then
            ' Increment count
            k = k + 1
            ' Copy row values
            For j = 1 To N_cols
                dst_vals(k, j) = src_vals(i, j)
            Next j
        End If
    Next i
    ' Bring rows back into destination range
    If k > 0 Then
        r_dst.Resize(k, N_cols).Value2 = dst_vals
    End If
End Sub

Public Function CountRows(ByRef r As Range) As Integer
    CountRows = r.Worksheet.Range(r, r.End(xlDown)).Rows.Count
End Function
Public Function CountColumns(ByRef r As Range) As Integer
    CountColumns = r.Worksheet.Range(r.End(xlToRight), r).Columns.Count
End Function

以下是我运行的一个测试用例:

之前

之后

- John Alexiou

---

我认为这种方法对于手头的任务来说过于复杂，任何速度上的优势都会被它所抵消。此外，还有更简洁的使用变体数组的方法。 - Gaijinhunter

我认为这不足以成为一个负分的理由。它是一个可行的解决方案，而且稳健且即时。复杂性在这里取决于观察者的眼光。请详细阐述一下使用“Variant”数组的“更清晰”的方法。 - John Alexiou

好的，没问题。稍后我会添加一个基于变体数组的答案，并提供更多解释。 - Gaijinhunter

Answer 3

您是想尝试这个吗？

Option Explicit

Sub Sample()
    Dim wsI As Worksheet, wsO As Worksheet
    Dim LastRow As Long, i As Long, j As Long

    Set wsI = Sheets("Sheet1")
    Set wsO = Sheets("Sheet2")

    LastRow = wsI.Range("A" & Rows.Count).End(xlUp).Row

    j = 1

    With wsI
        For i = 1 To LastRow
            If Val(Trim(.Range("A" & i).Value)) >= 10 Then
                wsI.Rows(i).Copy wsO.Rows(j)
                j = j + 1
            End If
        Next i
    End With
End Sub

- Siddharth Rout