快速对比数据

实例需求：日常工作中经常需要对比数据，例如如下的参会名单，现在需要对比两届参会名单的异同，100个人的名单，看得老眼昏花也未必能够准确的找出差异。

Function strCompare(ByVal Rng1 As Range, ByVal Rng2 As Range) As String
    Dim strRemove As String, strAdd  As String, strKey
    Dim currDic, newDic, c
    Set currDic = CreateObject("scripting.dictionary")
    Set newDic = CreateObject("scripting.dictionary")
    For Each c In Rng1
        currDic(c.Value) = ""
    Next c
    For Each c In Rng2
        newDic(c.Value) = ""
    Next c
    For Each strKey In currDic.keys
        If Not newDic.exists(strKey) Then strRemove = strRemove & " " & strKey
    Next strKey
    For Each strKey In newDic.keys
        If Not currDic.exists(strKey) Then strAdd = strAdd & " " & strKey
    Next strKey
    Set currDic = Nothing
    Set newDic = Nothing
    strCompare = "减少：" & Trim(strRemove) & vbNewLine & "新增：" & Trim(strAdd)
End Function
Sub demo()
    MsgBox strCompare(Range("A2:D26"), Range("F2:I26")), , "对比结果"
End Sub

【代码解析】
数据中可能存在重复，那么首先要进行排重，然后再进行对比，数据去重那么非字典莫属。
自定义函数有两个参数，分别对应于需要对比的两个数据区域，二者形状可以相同，也可以不同。
第4和5行代码创建两个字段对象，分布保存两个数据清单。
第6~11行代码使用For Each循环，将数据分布加载到字典对象中，实现去重。
第12~14行代码查找存在于第一个数据区域中，但是第二个数据区域中不存在的名单。
第15~17行代码查找存在于第二个数据区域中，但是第以个数据区域中不存在的名单。
第18和19行代码是否对象变量占用的系统资源。
第20行代码设置自定义函数返回值。
第23行代码调用自定义函数，其结果如下。

第12~17行代码使用两个循环结构分别提取“减少”和“新增”的人员名单，其实可以简化如下。

Function strCompare(ByVal Rng1 As Range, ByVal Rng2 As Range) As String
    Dim strRemove As String, strAdd  As String, strKey
    Dim currDic, newDic, c
    Set currDic = CreateObject("scripting.dictionary")
    Set newDic = CreateObject("scripting.dictionary")
    For Each c In Rng1
        currDic(c.Value) = ""
    Next c
    For Each c In Rng2
        newDic(c.Value) = ""
    Next c
    For Each strKey In currDic.keys
        If Not newDic.exists(strKey) Then
            strRemove = strRemove & " " & strKey
        Else
            newDic.Remove strKey
        End If
    Next strKey
    strCompare = "减少：" & Trim(strRemove) & vbNewLine & "新增：" & Join(newDic.keys)
    Set currDic = Nothing
    Set newDic = Nothing
End Function

如果currDic中的键值存在于newDic中，那么将移除该键值，否则就追加到“减少”人员名单中，这样只需要一个循环就可以提取两个人员名单了。
当然设置函数返回值的语句也需要变更一点，使用Join(newDic.keys)生成“新增”人员名单。

---

枯燥的重复劳动交给VBA来实现，肯定没问题。