VBA双循环运行非常缓慢

下面的macros被创build来匹配员工姓名和徽章号码。 它需要在Excel中，而不是访问。 工作簿中有两张纸。 “全部”跟踪名字，第二名称和其他信息。 目前这种工作簿大约有8000行，并在不断增长。 “EmpCon List”（雇主/承包商）是他们的名字，第二个名字和徽章号码的数据库，并且具有大约450行的稳定数量.All和Emp Con之间有数据validation，因此他们的名字必须完美匹配

该macros被devise为将“全部”中的第一和第二名称与“EmpCon列表”中的名字相匹配，然后将其匹配到出现在“全部”中的徽章号码。

这个macros似乎是合乎逻辑的，是一个双重的For循环。 但是，程序运行几秒钟后没有正确响应，出现“白色”。 有没有办法帮助VBA处理这个？

Sub BadgeNumberLookUp() Dim i As Integer, j As Integer Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets("All").Select ' Job Number page JobRows = Application.CountA(Range("A:A")) + 10 ' This number is 8000 and growing Sheets("EmpCon List").Select 'Employee / Contractors sheet EmployeeCount = Application.CountA(Range("M:M")) + 10 ' This number is about 450 and stable For i = 1 To JobRows Sheets("All").Select jobPrenom = Cells(i, 1).Value jobSurname = Cells(i, 2).Value For j = 1 To EmployeeCount Sheets("EmpCon List").Select prenom = Cells(j, 13).Value surname = Cells(j, 14).Value indexNo = Cells(j, 12).Value badgeNumber = Cells(j, 15).Value ' Use UCase as sometimes the names are not always in lower/uppercase If UCase(prenom) = UCase(jobPrenom) And UCase(surname) = UCase(jobSurname) Then Sheets("All").Select Cells(i, 16).Value = badgeNumber Exit For End If Next j Next i Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub 

Answer 1

不是解决scheme（AFAIK），但我只是想告诉你如何减less你的代码（和select任何潜在的陷阱）。 这应该也是这样。 请注意，我如何创build了两个工作表variables，然后使用信息来自的工作表限定范围。

 Sub BadgeNumberLookUp_No_Select() Dim i As Integer, j As Integer Dim empConWS As Worksheet, allWS As Worksheet Set empConWS = Sheets("EmpCon List") Set allWS = Sheets("All") Application.ScreenUpdating = False Application.DisplayAlerts = False 'Sheets("All").Select ' Job Number page JobRows = Application.CountA(allWS.Range("A:A")) + 10 ' This number is 8000 and growing 'Sheets("EmpCon List").Select 'Employee / Contractors sheet EmployeeCount = Application.CountA(empConWS.Range("M:M")) + 10 ' This number is about 450 and stable For i = 1 To JobRows 'Sheets("All").Select With allWS jobPrenom = .Cells(i, 1).Value jobSurname = .Cells(i, 2).Value End with For j = 1 To EmployeeCount 'Sheets("EmpCon List").Select With empConWS prenom = .Cells(j, 13).Value surname = .Cells(j, 14).Value indexNo = .Cells(j, 12).Value badgeNumber = .Cells(j, 15).Value End With ' Use UCase as sometimes the names are not always in lower/uppercase If UCase(prenom) = UCase(jobPrenom) And UCase(surname) = UCase(jobSurname) Then 'Sheets("All").Select allWS.Cells(i, 16).Value = badgeNumber Exit For End If Next j Next i Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub 

运行这个，看看是否出现相同的错误。