Excel停止响应后一段时间-for循环vba

当我运行下面的代码时，Excel停止响应一段时间（5-6秒）

它能做什么：

在e1检查值是否在两张纸中的任何一张上存在，如果是，则将其中来自e1的值的行移动到另一张纸张上，如果没有find，则不执行任何操作

 Option Explicit Sub RemoveEmail() Dim wi, wn, wo, wr As Worksheet Dim e1 Dim FinalRowI, FinalRowN, FinalRowO, FinalRow Dim i, j Set wi = Sheet2 Set wn = Sheet3 Set wo = Sheet4 Set wr = Sheet5 FinalRowI = wi.Range("B1048576").End(xlUp).Row FinalRowN = wn.Range("C1048576").End(xlUp).Row FinalRowO = wo.Range("C1048576").End(xlUp).Row FinalRow = WorksheetFunction.Max(FinalRowN, FinalRowO) For i = 2 To FinalRowI e1 = Trim(wi.Range("B" & i).Text) For j = 2 To FinalRow If Trim(wn.Range("C" & j).Text) = e1 Or Trim(wo.Range("C" & j).Text) = e1 Then wi.Cells(i, "A").EntireRow.Cut Destination:=wr.Range("A" & wr.Rows.Count).End(xlUp).Offset(1) Else: End If Application.CutCopyMode = False Next j Next i End Sub 

Answer 1

你不应该检查Range.Text属性，除非有一些单元格格式会改变结果。 对于文本（email …？）， Range.Value2属性是最有效的。 而且，一旦你find了一个匹配，并且xlCut把这一行排除在原始位置之外，那么继续循环就没有意义了。 继续下一个值。

 For i = 2 To FinalRowI e1 = Trim(LCase(wi.Range("B" & i).Value2)) 'unless you have formatting you want to check, .Text is inefficient For j = 2 To FinalRow If Trim(lcased(wn.Range("C" & j).Value2)) = e1 Or Trim(LCase(wo.Range("C" & j).Value2)) = e1 Then wi.Cells(i, "A").EntireRow.Cut Destination:=wr.Range("A" & wr.Rows.Count).End(xlUp).Offset(1) Exit For 'you've cut out the row. no need to continue End If 'Application.CutCopyMode = False 'no need for this on a cut Next j Next i 

请参阅我应该在退出子程序之前再次打开.CutCopyMode吗？ 有关为什么Application.CutCopyMode = False更多信息是不必要的。

build议使用本机工作表COUNTIF函数切换到此方法。

 For i = 2 To FinalRowI e1 = Trim(wi.Range("B" & i).Value2) If CBool(Application.CountIf(wn.Columns(3), e1)) Or CBool(Application.CountIf(wr.Columns(1), e1)) Then wi.Cells(i, "A").EntireRow.Cut _ Destination:=wr.Range("A" & Rows.Count).End(xlUp).Offset(1) End If Next i 

MATCH函数更加高效，但是您必须为IsError两次（每个工作表一次）进行testing。