VBA - 函数有效，但 Excel 崩溃

Question

我有这样的功能来匹配两张纸之间的数据。在 Tab 中，只有几行需要从表 Dan 中获取 ID 号，其中包含大约 10 000 个 ID。

Sub MatchName()
Dim n1 As Long
Dim n2 As Long

 Dim LastRowcheck1 As Long
 Dim LastRowcheck2 As Long
 
LastRowcheck1 = Sheets("Tab").Range("C" & Rows.Count).End(xlUp).Row
LastRowcheck2 = Sheets("Dan").Range("A" & Rows.Count).End(xlUp).Row

Sheets("Tab").Activate
 For n1 = 2 To LastRowcheck1
   For n2 = 2 To LastRowcheck2
        Debug.Print "From: " & Sheets("Dan").Cells(n2, 1).Value & " to " & Sheets("Tab").Cells(n1, 3).Value
        If Sheets("Tab").Cells(n1, 3).Value = Sheets("Dan").Cells(n2, 1).Value Then
            Sheets("Tab").Cells(n1, 6).Value = Sheets("Dan").Cells(n2, 1).Value
            Sheets("Tab").Cells(n1, 30).Value = Sheets("Dan").Cells(n2, 2).Value
        End If
    Next n2
  Next n1
End Sub

Answer 1

您不需要 2 个循环。

遍历其中一张纸上的相关列，并使用Application.Match 查找另一张纸上的相关列中是否有匹配项。

如果有匹配则复制数据。

Option Explicit

Sub MatchName()
Dim n1 As Long
Dim LastRowcheck1 As Long
Dim Res As Variant
 
    LastRowcheck1 = Sheets("Tab").Range("C" & Rows.Count).End(xlUp).Row

    For n1 = 2 To LastRowcheck1
    
        Res = Application.Match(Sheets("Tab").Cells(n1, 3), Sheets("Dan").Columns(1), 0)
        
        If Not IsError(Res) Then
            
            Sheets("Tab").Cells(n1, 6).Value = Sheets("Dan").Cells(Res, 1).Value
            Sheets("Tab").Cells(n1, 30).Value = Sheets("Dan").Cells(Res, 2).Value
        End If
        
    Next n1
    
End Sub

Answer 2

当宏执行时间过长时，Excel 往往会冻结。即使 'Tab' 只包含 10 行，仍然是 100000 个循环。

DoEvents 函数可防止冻结。确保以每隔一段时间发生一次的方式包含它（比如每 1000 个循环）。您也可以在每个循环中包含它，但它可能会减慢速度（这是我的猜测）。

请注意，运行该子例程可能仍需要很长时间。这里有两种加速它的方法，所以你甚至可能不需要 DoEvents：

1. 当 If 条件为真时，如果我理解正确的话，您基本上完成了 n2 循环。使用“Exit For”提前结束 n2 循环，因为无需检查剩余的最多 9999 行。
2. 找到一种对“Dan”数据进行排序的方法，使它们与“Tab”数据的顺序相同。根据您的数据，可能是在您找到 n1=2 的匹配项后，例如 n2=1000 您不必从 n2=2 重新开始 n1=3，因为您已经知道匹配项不会是在前 1000 个条目中。所以你可以不从 n2=2 而是从 n2=1000 开始循环。退出循环时，您必须将 n2 的值存储在一个变量中，如 1) 所述，或者使用 Do Until 创建一个自定义 For 循环。但这取决于您拥有的数据类型。不过，它可能会大大减少您需要的循环数量。