Question

创建以下宏以将员工姓名与徽章编号匹配。它需要是excel而不是访问。工作簿中有两个表。＆＃34;所有＆＃34;跟踪名字，名字和其他信息。这个工作簿目前大约有8000行，而且还在增长。＆＃34; EmpCon列表＆＃34; （雇主/承包商）是他们的名字，第二名和徽章编号的数据库，并且具有大约450的稳定行数。在All和Emp Con之间有数据验证，因此他们的名字必须完全匹配

该宏旨在匹配＆＃34; All＆＃34;中的第一个和第二个名称。反对＆＃34; EmpCon List＆＃34;中的名字，然后将其与将出现在＆＃34; All＆＃34;中的徽章编号相匹配。

宏似乎是合乎逻辑的，一个双For循环。但是，该程序没有正确响应并且＆＃34;白色＆＃34;几秒钟后跑步。有没有办法帮助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

不是解决方案（AFAIK），但我只是想告诉你如何减少你的代码（以及.Select的任何潜在陷阱）。这应该做同样的事情。请注意我是如何创建两个工作表变量，然后使用信息来自的工作表限定范围。

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

运行此命令并查看是否发生了相同的错误。

VBA双循环运行速度非常慢

1 个答案: