1

我是 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
4

1 回答 1

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
于 2013-06-14T14:55:22.230 回答