Excel 2016中如何用VBA自动补全员工缺失的培训课程

核心功能 #

• 遍历指定员工培训记录表的所有员工姓名，去重后逐个处理
• 对比独立工作表「课程主表」的模块ID，识别每个员工未完成的模块
• 自动在员工培训表中插入新行，填充员工姓名与缺失的模块ID
• 针对Excel 2016虚拟机做性能优化，适配1500-15000行的数据集

完整VBA代码 #

Sub 补全员工缺失培训模块()
    ' 声明变量
    Dim wsEmp As Worksheet, wsMaster As Worksheet
    Dim empNames As Collection, masterModules As Collection
    Dim empData As Variant, masterData As Variant
    Dim i As Long, j As Long, k As Long
    Dim currentName As String, moduleID As String
    Dim isMissing As Boolean
    
    ' 性能优化：关闭不必要的Excel功能
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' 指定工作表（可根据实际修改名称）
    Set wsEmp = ActiveSheet ' 当前活动工作表为员工培训记录表
    Set wsMaster = ThisWorkbook.Worksheets("课程主表") ' 课程主表
    
    ' 读取数据到数组（减少工作表交互，提升速度）
    empData = wsEmp.Range("A1:B" & wsEmp.Cells(wsEmp.Rows.Count, "A").End(xlUp).Row).Value
    masterData = wsMaster.Range("B1:B" & wsMaster.Cells(wsMaster.Rows.Count, "B").End(xlUp).Row).Value
    
    ' 收集去重的员工姓名
    Set empNames = New Collection
    On Error Resume Next ' 忽略重复添加的错误
    For i = 2 To UBound(empData) ' 假设第一行是表头
        empNames.Add empData(i, 1), Key:=CStr(empData(i, 1))
    Next i
    On Error GoTo 0 ' 恢复错误处理
    
    ' 收集课程主表的模块ID（去重）
    Set masterModules = New Collection
    On Error Resume Next
    For i = 2 To UBound(masterData) ' 假设第一行是表头
        masterModules.Add masterData(i, 1), Key:=CStr(masterData(i, 1))
    Next i
    On Error GoTo 0
    
    ' 遍历每个员工，检查缺失模块并插入
    For Each currentName In empNames
        ' 遍历主表的每个模块ID
        For Each moduleID In masterModules
            isMissing = True
            ' 检查该员工是否已存在此模块
            For i = 2 To UBound(empData)
                If empData(i, 1) = currentName And empData(i, 2) = moduleID Then
                    isMissing = False
                    Exit For
                End If
            Next i
            
            ' 如果缺失，插入新行并填充数据
            If isMissing Then
                ' 在员工培训表最后一行插入新行
                wsEmp.Cells(wsEmp.Rows.Count, "A").End(xlUp).Offset(1, 0).EntireRow.Insert
                wsEmp.Cells(wsEmp.Rows.Count, "A").End(xlUp).Value = currentName
                wsEmp.Cells(wsEmp.Rows.Count, "A").End(xlUp).Offset(0, 1).Value = moduleID
            End If
        Next moduleID
    Next currentName
    
    ' 恢复Excel默认设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    
    MsgBox "缺失模块补全完成！"
End Sub

性能优化说明 #

• 数组读取数据：将工作表数据一次性读入数组，避免频繁读写工作表（VBA中工作表交互是最耗时的操作）
• 关闭屏幕更新：Application.ScreenUpdating = False 避免每插入一行就刷新界面
• 禁用事件触发：Application.EnableEvents = False 防止插入行时触发其他自定义宏
• 手动计算：Application.Calculation = xlCalculationManual 避免每次插入行时自动重算公式
• 去重处理：先收集去重的员工姓名和模块ID，减少重复遍历次数

使用步骤 #

1. 确保你的课程主表名称为课程主表，若名称不同，修改代码中Set wsMaster = ThisWorkbook.Worksheets("课程主表")的工作表名称
2. 打开员工培训记录表，确保表头在第一行（A列为姓名，B列为模块ID）
3. 备份原始数据（避免意外）
4. 按Alt+F11打开VBA编辑器，插入新模块，粘贴上述代码
5. 运行宏，等待完成后查看结果

内容的提问来源于stack exchange，提问作者Abyssal Platypus