Question

我有这样的功能来匹配两张工作表之间的数据。在 Tab 中，只有几行需要从包含大约 10 000 个 ID 的表单 Dan 中获取 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：

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

VBA - 函数有效，但 Excel 崩溃

2 个答案: