比较两个单元格中的内容，提取不同词段

mrprofessor

如附件，需求背景情况如下： 工作表.zip (6.41 KB, 下载次数: 11)

2018-10-12 11:13 上传

点击文件名下载附件

（1）比较A、B两列；
（2）两列单元格中的“词段”（暂且自定义为词段吧，不知道怎么表述合适）由空格或半角逗号分隔开来；单元格中没有重复词段；
（3）查找两列的不同词段，结果分列在C、D两列（如图）；
增加需求：
（0）先把单元格中的“R115-R117”这种类型的写法，替换成“R115 R116 R117”的写法再做比较。




相当于比较两个装了不同词段的池子，哪位大神有办法，快来秀一下代码，给你撒花！

一把小刀闯天下

'你这示例结果是否正确？

Option Explicit

Sub test()
  Dim i, j, k, t, arr, brr()
  ReDim dic(1 To 2)
  For i = 1 To UBound(dic)
    Set dic(i) = CreateObject("scripting.dictionary")
  Next
  arr = [a1].CurrentRegion
  For i = 2 To UBound(arr, 1)
    For j = 1 To 2
      dic(j).RemoveAll
      t = Replace(Replace(arr(i, j), "，", ","), Space(1), ",")
      t = Split(t, ",")
      For k = 0 To UBound(t)
        If Len(t(0)) Then dic(j)(t(k)) = vbNullString
    Next k, j
    If getdata(dic(1), dic(2), brr) Then arr(i, 3) = Join(brr, ",") Else arr(i, 3) = vbNullString
    If getdata(dic(2), dic(1), brr) Then arr(i, 4) = Join(brr, ",") Else arr(i, 4) = vbNullString
  Next
  [a1].Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End Sub

Function getdata(dic1, dic2, arr) As Boolean
  Dim key, n
  For Each key In dic1
    If Not dic2.exists(key) Then
      n = n + 1: ReDim Preserve arr(1 To n)
      arr(n) = key
    End If
  Next
  If n > 0 Then getdata = True
End Function

mrprofessor

一把小刀闯天下 发表于 2018-10-12 12:38
'你这示例结果是否正确？

Option Explicit

谢谢小刀老师。
我示例中第二行的结果确实弄错了。
能不能增加个需求：先把单元格中的“R115-R117”这种类型的写法，替换成“R115 R116 R117”的写法再做比较。

再次感谢！

mrprofessor

一把小刀闯天下 发表于 2018-10-12 12:38
'你这示例结果是否正确？

Option Explicit

示例第2行确实不对，谢谢小刀大神！我再测试测试……