单元格文本差异比较(BOM位号差异)-[已解决]

myj_su · 发表于 2009-4-28 23:34

单元格A1中:C1,C3,C4,C6,C9, C10,C15~C17,C19, C20,C21,C22,C24,C25, C26,C27,C28,C31,C32, C33,C34,C35,C36,C39, C41,C46,C47,C48,C49
单元格B1中:C1,C3,C4,C6,C7,C9, C10,C15~C18,C19, C20,C21,C22,C24,C25, C26,C27,C28,C31,C32, C33,C35,C36,C39, C41,C46~C49

要求在单元格C1中显示, B1文本比A1文本增加的位号
在单元格D1中显示, B1文本比A1文本减少的位号
如本例:
单元格C1中应含:C7,C18,
单元格D1中应含:C34
注意: C15~C17, 意味 C15,C16,C17
一个不成熟的思路是使用Split函数,但要解决~的问题; 不知有无比较成熟的方法,函数或VBA皆可

[ 本帖最后由 myj_su 于 2009-6-7 11:55 编辑 ]

jymao · 发表于 2009-4-29 13:06

什么差异啦?比如A1是ABC,A2是BCD,那差异是什么?

myj_su · 发表于 2009-4-29 22:27

楼上说的很有道理,是我没想的周到,我重新改了一下,应该更清楚了

[ 本帖最后由 myj_su 于 2009-4-29 22:36 编辑 ]

myj_su · 发表于 2009-4-30 21:45

祝大家节日快乐, 请帮忙看看喽

zhaogang1960 · 发表于 2009-5-2 00:45

请测试:
Sub Macro1()
Dim arr, brr(1 To 2), a, b, d As Object, dic As Object
Dim s As String, i As Long
arr = Range("A1:B1")
For i = 1 To 2
      s = ""
      a = Split(arr(1, i), ",")
      For j = 0 To UBound(a)
         If InStr(a(j), "~") = 0 Then
            s = s & a(j) & ","
         Else
            b = Split(a(j), "~")
            For k = Val(Right(b(0), Len(b(0)) - 1)) To Val(Right(b(1), Len(b(1)) - 1))
                  s = s & "C" & k & ","
            Next
         End If
      Next
      brr(i) = Left(s, Len(s) - 1)
Next
Set d = CreateObject("scripting.dictionary")
a = Split(brr(1), ",")
b = Split(brr(2), ",")
For i = 0 To UBound(b)
      d(b(i)) = ""
Next
For i = 0 To UBound(a)
      If d.exists(a(i)) Then d.Remove (a(i))
Next
Set dic = CreateObject("scripting.dictionary")
For i = 0 To UBound(a)
      dic(a(i)) = ""
Next
For i = 0 To UBound(b)
      If dic.exists(b(i)) Then dic.Remove (b(i))
Next
Range("C1:D1").ClearContents
[C1] = Join(d.keys, ",")
[d1] = Join(dic.keys, ",")
End Sub

northwolves · 发表于 2009-5-3 01:34

Sub macro1()
Dim r As Range, dic As Object
Set dic = CreateObject("scripting.dictionary")
For Each r In Range(Replace([a1], "~", ":"))
dic(r.Address) = r.Address(0, 0)
Next
For Each r In Range(Replace([b1], "~", ":"))
If dic.exists(r.Address) Then
dic(r.Address) = r.Address
Else
dic(r.Address(0, 0)) = r.Address
End If
Next
[c1] = Join(Filter(dic.keys, "$", False), ",")
[d1] = Join(Filter(dic.items, "$", False), ",")
Set dic = Nothing
End Sub

复制代码

myj_su · 发表于 2009-5-4 22:01

多谢zhaogang 兄,让我学到了instr函数
多谢狼版主,你对字典的使用真是出神入化啊,我找到了你当初的教材,真是宝典啊
向大家推荐:
http://club.excelhome.net/viewth ... ighlight=dictionary

myj_su · 发表于 2009-6-3 23:31

原帖由 northwolves 于 2009-5-3 01:34 发表

Sub macro1()
Dim r As Range, dic As Object
Set dic = CreateObject("scripting.dictionary")
For Each r In Range(Replace([a1], "~", ":"))
dic(r.Address) = r.Address(0, 0)
Next
For Each r In Range ...

狼版, 发现一个问题,如果[A1]的长度超过252,超过range 上限,就会出错了,狼版昨天提示使用 union, 但我想把它做成function,有办法吗?

northwolves · 发表于 2009-6-4 22:34

请上传附件供测试

myj_su · 发表于 2009-6-4 23:06

原帖由 northwolves 于 2009-6-4 22:34 发表
请上传附件供测试

Book1.rar (13.08 KB, 下载次数: 54)

上传了附件, 使用自定义函数
发现range对象应用超过252(?)就会出错,已用红色表示出来了

		自动登录	找回密码
密码			免费注册

[求助] 单元格文本差异比较(BOM位号差异)-[已解决]