【Excel VBA 编程】单元格内多行文本“拆”与“合”

在Excel中，B列数据是A列数据的子集，要求快速找出A列中存在而B列中不存在的差异项，如下图所示

这是一个涉及单元格内多行文本处理和集合差异比对的复合需求，即两个文本数据进行一个减法操作，将A列多出来的内容输出到C列，最终显示格式及结果：

请按照以下步骤操作：

• 复制并粘贴代码：将提供的VBA代码复制，然后在Excel的VBA编辑器里，新建一个“标准模块”，把代码粘贴进去

• 选择工作表：回到Excel工作表界面，用鼠标点击左下角的工作表名称，打开想要处理的工作表，即为当前活动工作表（ActiveSheet）

• 运行代码：最后，按F5执行刚才粘贴好的宏代码，它只会对当前活动工作表的数据进行处理

代码参考

Sub GetDiffItems()    Dim ws As Worksheet    Dim lastRow As Long, i As Long, j As Long, diffCount As Long    Dim arrA() As String, arrB() As String, diffItems() As String, resultStr As String    Dim dict As Object    Set ws = ActiveSheet '默认当前活动工作表    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row    '创建字典对象用于快速查找    Set dict = CreateObject("Scripting.Dictionary")    ' 循环遍历每一行    For i = 1 To lastRow        ' 清空字典，为每一行独立的比对做准备        dict.RemoveAll        ' 获取并拆分B列单元格内容（处理空单元格）        If Len(Trim(ws.Cells(i, "B").Value)) > 0 Then            arrB = Split(ws.Cells(i, "B").Value, Chr(10))            For j = LBound(arrB) To UBound(arrB)                dict(Trim(arrB(j))) = True            Next j        Else            ' 如果B列为空，则清空数组            Erase arrB        End If        ' 获取并拆分A列单元格内容，同时查找差异        diffCount = 0        Erase diffItems ' 清空差异数组        If Len(Trim(ws.Cells(i, "A").Value)) > 0 Then            arrA = Split(ws.Cells(i, "A").Value, Chr(10))            ' 遍历A列的每一个元素            For j = LBound(arrA) To UBound(arrA)                Dim currentItem As String                currentItem = Trim(arrA(j))                ' 如果当前元素不在字典中（即不在B列），则加入差异数组                If Len(currentItem) > 0 And Not dict.exists(currentItem) Then                    ' 动态扩展差异数组                    ReDim Preserve diffItems(diffCount)                    diffItems(diffCount) = currentItem                    diffCount = diffCount + 1                End If            Next j        End If        ' 将差异数组组合成字符串，写入C列        If diffCount > 0 Then            resultStr = Join(diffItems, Chr(10))        Else            resultStr = "" ' 如果没有差异，则输出空        End If        ws.Cells(i, "C").Value = resultStr    Next i    ' 清理对象并提示完成    Set dict = Nothing    MsgBox "完成！结果输出到C列"End Sub