删除单元格内相同的数字

liyn0235

同一单元格内的数字，删除相同字符串，保留唯一

liulang0808

1. Sub 按钮1_Click()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     [b1] = "新列"
   
4.     arr = [a1].CurrentRegion
   
5.     For j = 2 To UBound(arr)
   
6.         brr = Split(arr(j, 1), " ")
   
7.         d.RemoveAll
   
8.         For i = 0 To UBound(brr)
   
9.             d(brr(i)) = ""
   
10.         Next i
    
11.         arr(j, 2) = Join(d.keys)
    
12.     Next j
    
13.     [a1].CurrentRegion = arr
    
14. End Sub
    

复制代码

liulang0808

附件内容供参考。。。。。。

jiminyanyan

2 楼老师的代码OK。

duquancai

请测试》》》》》》》》》》》》》》》》》》》》

1. Sub main()
   
2.     Dim r&, js As Object
   
3.     r = Cells(Rows.Count, 1).End(3).Row - 1
   
4.     Set js = CreateObject("MSScriptControl.ScriptControl")
   
5.     js.Language = "JavaScript": js.AddObject "g", Range("a2")
   
6.     js.eval "l=" & r & ";for(i=0;i<l;i++){a=[];b=g(i+1,1).text.split(/\x20+/);for(j=0;j<b.length;j++)a[b[j]]='';c=[];for(k in a)c.push(k);g(i+1,2)=c.join(' ')}"
   
7.     MsgBox "ok!"
   
8. End Sub

复制代码

Kaohsing

试试

1. Sub kao() '
   
2.     Dim js  As Object, i%
   
3.     Set js = CreateObject("scriptcontrol"):    js.Language = "jscript"
   
4.     js.eval "function aa(aa){ bb=(aa + '').split(' ');var cc=new Array();l=bb.length;for(i=0;i<l;i++){ for(j=i+1;j<l;j++){ if(bb[i]==bb[j]){ bb.splice(j,1);l--;j--;}}} return bb.join(' ');};"
   
5.     For i = 2 To [a2].End(4).Row
   
6.          Cells(i, 2) = js.Run("aa", Cells(i, 1).Value)
   
7.     Next
   
8. End Sub
   

复制代码

LMY123

d.removeall,join