当 Excel 2016 中一个列表重复时如何比较两个列表

Question

我目前正在处理大量不同长度（1500-15000 行）的数据表，记录员工的培训记录。当前由前员工构建的系统没有自动化，并且使用该表的部门需要很长时间才能更新它。因为他们必须去找每个员工添加课程。

我想做的是自动化为每个员工添加培训课程的任务。目前，每个员工页面都有一个“课程主列表”，每个页面代表各个部门。宏的目标是按员工姓名迭代列表，并将每个员工下的培训模块 ID 与“硕士课程列表”进行比较，以及“硕士课程列表”中是否存在“硕士课程列表”中不存在的模块。员工列表'，然后宏将添加新模块。

这将是一个非常精简版的员工培训清单：

姓名	模块
乔测试	TM.001.A
乔测试	TM.001.B
乔测试	TM.002.A
简测试	TM.001.A

培训课程列表类似于：

模块名称	模块ID
课程1	TM.001.A
课程2	TM.001.B

我目前已经构建了几行短代码，这些代码按名称进行迭代，我将其用于其他几个子程序，但我对此不太了解 VBA。

迭代循环如下所示：

Dim col As Range, curr As Range
Set col = Range(Range("A2"), Range("A2").End(xldown))
Dim col_val As String
For Each curr In col
    If curr.Value = col_val Then
        do stuff
    Else
        col_val = curr.Value
    End If
Next

当前会逐一迭代名称并存储当前的工作名称。我的想法是，当名称更改时，将设置或重置计数器，当主循环迭代时，该计数器将增加以与硕士课程列表进行比较，并且当遇到差异时，将添加并填充新行以员工列表和循环将继续。诀窍在于，它将一长串重复信息与一个短列表进行比较，区别在于员工姓名。

一些小注释：我不打算以迭代书中每张纸的方式来构建它，因为硕士课程列表是不定期和单独更新的。所以这个宏只会根据需要按页面运行。我也有兴趣尽一切可能减少处理时间，因为这一切都是在使用 Excel 2016 的 VM 上运行的。我在 C++ 和 Python 以及相当多其他语言方面拥有丰富的经验，但这是我第一次使用 VBA。此外，这只是一个临时修复，直到我可以构建一个更有效的解决方案，并且不需要该系统当前所需的工作量。

预先感谢您提供的任何建议和帮助。

Answer 1

Sub Demo()
    Dim objDic As Object, rngCell As Range
    Dim i As Long, sKey
    Dim arrData, arrRes, iR As Long
    Dim oSht1 As Worksheet, oSht2 As Worksheet
    Set oSht1 = Sheets("MasterCourseList")
    Set oSht2 = Sheets("TrainingList")
    Set objDic = CreateObject("scripting.dictionary")
    arrData = oSht2.Range("A1").CurrentRegion.Value
    Set rngCell = oSht2.Cells(UBound(arrData) + 1, 1)
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = arrData(i, 1)
        If Not objDic.exists(sKey) Then
            Set objDic(sKey) = CreateObject("scripting.dictionary")
        End If
        objDic(sKey).Add arrData(i, 2), Empty
    Next i
    ReDim arrRes(1 To UBound(arrData), 1)
    arrData = oSht1.Range("A1").CurrentRegion.Value
    For i = LBound(arrData) + 1 To UBound(arrData)
        For Each sKey In objDic.Keys
            If Not objDic(sKey).exists(arrData(i, 2)) Then
                iR = iR + 1
                arrRes(iR, 0) = sKey
                arrRes(iR, 1) = arrData(i, 2)
                sKey = sKey & sKey
            End If
        Next
    Next i
    If iR = 0 Then
        MsgBox "Nothing changed"
    Else
        rngCell.Resize(iR, 2) = arrRes
        MsgBox iR & " rows are added to " & oSht2.Name
    End If
End Sub