Question

我是VBA的新手，我知道必须有一种更简单，更有效的编写代码的方法，但不熟悉正确的功能（比如如何粘贴到下一个工作表而不粘贴现有数据）。它适用于较小的工作表，但我必须在60000+行的工作表上使用它。任何帮助将不胜感激。提前谢谢。

Sub test()
    Dim row As Long
    With Excel.Application
        .ScreenUpdating = False
        .Calculation = Excel.xlCalculationManual
        .EnableEvents = False
    End With

For row = 1 To 65500
If ThisWorkbook.ActiveSheet.Cells(row, 14) <> "" Then
    ThisWorkbook.ActiveSheet.Cells(row, 1).EntireRow.Copy
    ThisWorkbook.ActiveSheet.Paste Destination:=ThisWorkbook.Sheets("SCO").Cells(row, 1)
    ThisWorkbook.ActiveSheet.Cells(row + 1, 1).EntireRow.Copy
    ThisWorkbook.ActiveSheet.Paste Destination:=ThisWorkbook.Sheets("SCO").Cells(row + 1, 1)

End If

Next

For row = 1 To 65500
If ThisWorkbook.Sheets("SCO").Cells(row, 14) = "" Then
    ThisWorkbook.Sheets("SCO").Cells(row, 20).Value = 2
End If
Next
For x = 65500 To 1 Step -1
    If ThisWorkbook.Sheets("SCO").Cells(x, 3) = "" Then
    ThisWorkbook.Sheets("SCO").Cells(x, 1).EntireRow.Delete
End If
Next
For row = 1 To 65500
If ThisWorkbook.Sheets("SCO").Cells(row, 20) = 2 Then
    ThisWorkbook.Sheets("SCO").Cells(row + 1, 1).EntireRow.Insert shift:=xlDown
End If

Next

With Excel.Application
    .ScreenUpdating = True
    .Calculation = Excel.xlAutomatic
    .EnableEvents = True
End With

End Sub

Answer 1

我建议使用自动过滤器过滤掉您想要的数据，然后使用ActiveSheet.UsedRange.Copy将过滤后的数据复制到新工作表中。此外，当您需要遍历所有数据而不是一直到65500时，请转到ActiveSheet.UsedRange.Rows.Count，这样您就不会遍历空单元格。

示例：

你看到的第一个循环看起来像是复制了第14列中没有空格的所有行。

For row = 1 To 65500
    If ThisWorkbook.ActiveSheet.Cells(row, 14) <> "" Then
        ActiveSheet.Cells(row, 1).EntireRow.Copy
        ActiveSheet.Paste Destination:=ThisWorkbook.Sheets("SCO").Cells(row, 1)
        ActiveSheet.Cells(row + 1, 1).EntireRow.Copy
        ActiveSheet.Paste Destination:=ThisWorkbook.Sheets("SCO").Cells(row + 1, 1)
    End If
Next

不是循环遍历所有数据，而是可以过滤它并复制结果，如下所示：

'Filter out blank rows in column 14
ActiveSheet.UsedRange.AutoFilter Field:=14, Criteria1:="<>"

'Copy and Paste the results to Sheet "SCO"
If Sheets("SCO").Range("A1").Value = "" Then
    ActiveSheet.UsedRange.Copy Destination:=Sheets("SCO").Range("A1")
Else
    ActiveSheet.UsedRange.Copy Destination:=Sheets("SCO").Cells(Sheets("SCO").UsedRange.Rows.Count, 1)
End If

此处你循环1到65500

For row = 1 To 65500
    If Sheets("SCO").Cells(row, 14) = "" Then
        Sheets("SCO").Cells(row, 20).Value = 2
    End If
Next

您可以这样做以减少需要循环的次数

For row = 1 To Sheets("SCO").UsedRange.Rows.Count
    If Sheets("SCO").Cells(row, 14) = "" Then
        Sheets("SCO").Cells(row, 20).Value = 2
    End If
Next

用于将某些数据从工作表复制并粘贴到另一个数据的VBA代码

1 个答案: