如果 2 列中有特定字符串，则用于将行从一个 sheet 复制到另一个的代码不断崩溃

Question

每当我运行这段代码它崩溃。请帮忙！

这就是代码应该做的。对于未知数量的填充行，如果工作的 G 列 sheet "Current PM" 包含 "AS-001"、"EE-001"、"MM-001"、"OS-001"、"CO-001"、"DO-001"、"FO-001"、"FD-001"、"TO-001"、"IP-001" H 列包含 "PDR"，然后将行从 "Current PM" sheet 复制到 "Print_Current PMs" sheet。

Sub Sort4Printing()

Dim i As Integer, j As Integer

i = 2: j = 2

While IsEmpty(Worksheets("Current PM").Cells(i, 1)) = False

If Worksheets("Current PM").Cells(i, 8) = "PDR" Then

If Worksheets("Current PM").Cells(i, 7) = "AS-001" Or Worksheets("Current PM").Cells(i, 7) = "EE-001" Or Worksheets("Current PM").Cells(i, 7) = "MM-001" Or Worksheets("Current PM").Cells(i, 7) = "OS-001" Or Worksheets("Current PM").Cells(i, 7) = "FO-001" Or Worksheets("Current PM").Cells(i, 7) = "FD-001" Or Worksheets("Current PM").Cells(i, 7) = "TO-001" Or Worksheets("Current PM").Cells(i, 7) = "IP-001" Then

Worksheets("Print_Current PMs").Cells(j, 1) = Worksheets("Current PM").Cells(i, 1)
Worksheets("Print_Current PMs").Cells(j, 2) = Worksheets("Current PM").Cells(i, 2)
Worksheets("Print_Current PMs").Cells(j, 3) = Worksheets("Current PM").Cells(i, 12)
Worksheets("Print_Current PMs").Cells(j, 4) = Worksheets("Current PM").Cells(i, 4)
Worksheets("Print_Current PMs").Cells(j, 5) = Worksheets("Current PM").Cells(i, 5)
Worksheets("Print_Current PMs").Cells(j, 6) = Worksheets("Current PM").Cells(i, 6)
Worksheets("Print_Current PMs").Cells(j, 7) = Worksheets("Current PM").Cells(i, 7)
Worksheets("Print_Current PMs").Cells(j, 8) = Worksheets("Current PM").Cells(i, 8)
Worksheets("Print_Current PMs").Cells(j, 9) = Worksheets("Current PM").Cells(i, 10)



  i=i+1: j=j+1
End If
End If
Wend

End Sub

Answer 1

虽然我不知道确切它崩溃的原因，但我可以提供一些clean-up和技术来减少代码的处理。

无需遍历 2 个变量，因为它们都是相同的计数器
将计数变量标注为 Long 类型，就好像有超过 32,767 行的 Integer 变量会由于其字节限制而下降。
使用 With 块将有助于处理对象，而不是总是引用对象
对同一对象的多个条件使用 Select Case 语句将（我相信）比多个 If Or 条件需要更少的处理。它还很多更 reader 友好。

查看重构代码：

Sub Sort4Printing()

Dim i As Long

i = 2

With Worksheets("Current PM")

    While Not IsEmpty(.Cells(i, 1))

        If .Cells(i, 8) = "PDR" Then

            Select Case .Cells(i, 7)

                Case Is = "AS-001", "EE-001", "MM-001", "OS-001", "FO-001", "FD-001", "TO-001", "IP-001"

                    Worksheets("Print_Current PMs").Cells(i, 1) = .Cells(i, 1)
                    Worksheets("Print_Current PMs").Cells(i, 2) = .Cells(i, 2)
                    Worksheets("Print_Current PMs").Cells(i, 3) = .Cells(i, 12)
                    Worksheets("Print_Current PMs").Cells(i, 4) = .Cells(i, 4)
                    Worksheets("Print_Current PMs").Cells(i, 5) = .Cells(i, 5)
                    Worksheets("Print_Current PMs").Cells(i, 6) = .Cells(i, 6)
                    Worksheets("Print_Current PMs").Cells(i, 7) = .Cells(i, 7)
                    Worksheets("Print_Current PMs").Cells(i, 8) = .Cells(i, 8)
                    Worksheets("Print_Current PMs").Cells(i, 9) = .Cells(i, 10)

            End Select

        End If

        i = i + 1

    Wend

End With

End Sub

Answer 2

至于它崩溃的原因，我想你的意思是它进入了一个无限循环，除非你强制 excel 关闭，否则你无法退出。

行 i=i+1: j=j+1 需要在两个 if 语句之外。

...  
End If
End If

i=i+1: j=j+1
Wend

End Sub

当它遇到不满足 If 要求的行时，它不会递增，因此它会继续一遍又一遍地测试同一行，直到您厌倦并关闭 Excel。

话虽如此，这仅供参考。 Scott Holtzman 的回答有更好的方法论和学习许多缺乏的东西的好地方。

如果 2 列中有特定字符串，则用于将行从一个 sheet 复制到另一个的代码不断崩溃

Code meant to copy rows from one sheet to another if there are specific strings in 2 columns keeps crashing

excel

vba

copy

paste