消除两个单元格中重复数字

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, i, j, t
  arr = [a1].CurrentRegion
  ReDim brr(1 To UBound(arr, 1) - 1, 1 To 1)
  For i = 2 To UBound(arr, 1)
    t = Split(arr(1, 1) & "," & arr(i, 1), ",")
    ReDim pos(99) As Long
    For j = 0 To UBound(t)
      If Len(t(j)) Then pos(t(j)) = pos(t(j)) + 1
    Next
    For j = 0 To UBound(pos)
      If pos(j) > 0 Then brr(i - 1, 1) = brr(i - 1, 1) & "," & Format(j, "00")
    Next
    brr(i - 1, 1) = Mid(brr(i - 1, 1), 2)
  Next
  With [a7] '输出位置自己修改
    .Resize(Rows.Count - 6).ClearContents
    .Resize(UBound(brr, 1)) = brr
  End With
End Sub

duquancai

dengtianen 发表于 2018-7-27 20:03
谢谢大神了，这里还有个问题，如何我要分别对a1与a2，a1与a3的数字进行合并，同时合并的过程中必须消除其中 ...

' 合并后去重复，另降序与升序交替输出

1. Sub main()
   
2.     Dim a, i&, b(), j$
   
3.     a = [a1:a3] '根据实际数据 初始化数据
   
4.     ReDim b(1 To UBound(a) - 1, 1 To 1)
   
5.     Set js = CreateObject("MSScriptControl.ScriptControl")
   
6.     js.Language = "JavaScript"
   
7.     For i = 2 To UBound(a)
   
8.         j = "o={};('" & a(1, 1) & "'+','+'" & a(i, 1) & "').replace(/[^,]+/g,function(s){o[s]=1;});"
   
9.         b(i - 1, 1) = js.eval(j & "s=[];for(k in o)s.push(k);l=" & i & ";function q(n){return function(x,y){return n&1?x-y:y-x;};};s.sort(q(l));")
   
10.     Next
    
11.     [a4].Resize(UBound(b)) = b '输出位置自己修改
    
12. End Sub

复制代码