无法将行复制到不同工作表中的下一个空行

Question

我的作业有问题。

我的这张表有18287名学生。每排一个。他们有个人身份证，他们有不同的校园，他们已经在不同的时间注册了他们的教育等。

我正在建立一个循环代码，找到延迟并已被回滚的学生。如果他们被推迟，H栏必须低于133.同样我正在寻找目前正在攻读学士学位的学生。这意味着L列必须是＆＃34; Bachelor＆＃34;。我的循环当时看起来像这样：

for i = 2 to 18288
If worksheets(1).range(i,5)<133 and worksheets(1).range(i,11)="Bachelor" then
worksheets(1).row(i).copy

我试图将行复制到工作表中的第一个空行（延迟学生）。我尝试了很多不同的方法。其中一些人没有复制任何东西，其他尝试导致excel关闭...我已经搜索了Google，我得出的结论是.select，.copy，.paste程序非常苛刻，可能会导致崩溃。

所以我正在寻找代码，我不必复制行。对此有任何帮助，我自己用完了可能的解决方案..？

Answer 1

你有没有考虑过滤色谱柱H＆lt; 133和L为“Bachelor”？我认为过滤器更容易，甚至更快。

With Worksheets(1).UsedRange
    .AutoFilter Field:=8, Criteria1:="<133", Operator:=xlAnd
    .AutoFilter Field:=12, Criteria1:="=Bachelor", Operator:=xlAnd
    .SpecialCells(xlCellTypeVisible).Copy
End With
Worksheets("SheetToPasteIn").Range("A1").PasteSpecial

Answer 2

代码最耗费的时间是访问工作表，如Copy命令。您可以使用CopyRng对象通过Rows函数合并通过条件的所有Union来最小化。

最后，您只需Copy整个范围。

注意：列＆＃34; H＆＃34;在循环中使用Range应为Range("H" & i)，而不是range(i,5)。对于另一种情况也一样。

尝试以下修改后的代码：

Dim i As Long
Dim CopyRng As Range

With Worksheets(1)
    For i = 2 To 18288
        If .Range("H" & i).Value < 133 And .Range("K" & i).Value2 = "Bachelor" Then
            If Not CopyRng Is Nothing Then
                Set CopyRng = Application.Union(CopyRng, .Rows(i))
            Else
                Set CopyRng = .Rows(i)
            End If
        End If
    Next i
End With

' check at least 1 rows in the Range
If Not CopyRng Is Nothing Then CopyRng.Copy