单元格内容去重/排序

宝贝万岁

单元格内容用逗号隔开，如何去重/排序？？求教大神~，拜谢~

jiminyanyan

split,字典去重，排序，要用到的知识点还不少…………

paciguard

结果写到D列了。。。
Sub 按钮1_Click()
Dim a, b()
a = Range("A2:A" & [a65536].End(3).Row)
ReDim b(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
Dim d
Set d = CreateObject("Scripting.Dictionary")
For j = 0 To UBound(Split(a(i, 1), ","))
If Not d.exists(Val(Split(a(i, 1), ",")(j))) Then d.Add Val(Split(a(i, 1), ",")(j)), ""
Next j
Dim c
c = d.Count
Do While c > 0
If b(i, 1) = "" Then
b(i, 1) = WorksheetFunction.Min(d.keys())
Else
b(i, 1) = b(i, 1) & "," & WorksheetFunction.Min(d.keys())
End If
d.Remove WorksheetFunction.Min(d.keys())
c = d.Count
Loop
Next i
[d2].Resize(UBound(b), 1) = b
End Sub

jiminyanyan

Sub jimin()
    Set x = CreateObject("msscriptcontrol.scriptcontrol")
    x.Language = "javascript"
    x.addcode "function aa(bb){x=bb.split(',');x.sort(function(a,b){return a- b});for(i = 0; i<x.length;i++){if(x==x[i+1]){x.splice(i, 1);i=i-1;}};return x;}"
    n = Sheet1.Range("a65535").End(xlUp).Row
    For i = 2 To n
        kk = Sheet1.Cells(i, 1)
        Sheet1.Cells(i, 2) = x.eval("aa('" & kk & "')")
    Next
End Sub

paciguard

jiminyanyan 发表于 2017-8-13 09:48
这个没有去重功能…………
Sub jimin()
    Set x = CreateObject("msscriptcontrol.scriptcontrol")

如果用字典，去重，排序都可以搞定。。。

jiminyanyan

paciguard 发表于 2017-8-13 09:54
如果用字典，去重，排序都可以搞定。。。

实现是可以的……。
javascript的代码比较简洁Sub jimin()
    Set x = CreateObject("msscriptcontrol.scriptcontrol")
    x.Language = "javascript"
    x.addcode "function aa(bb){x=bb.split(',');x.sort(function(a,b){return a- b});for(i = 0; i<x.length;i++){if(x==x[i+1]){x.splice(i, 1);i=i-1;}};return x;}"
    n = Sheet1.Range("a65535").End(xlUp).Row
    For i = 2 To n
        kk = Sheet1.Cells(i, 1)
        Sheet1.Cells(i, 2) = x.eval("aa('" & kk & "')")
    Next
End Sub

宝贝万岁

jiminyanyan 发表于 2017-8-13 09:57
实现是可以的……。
javascript的代码比较简洁Sub jimin()
    Set x = CreateObject("msscriptcontrol ...

谢谢大神，没有去重功能，而且沃研究不懂这种代码。。。惭愧~

yaozong

宝贝万岁 发表于 2017-8-13 10:59
谢谢大神，没有去重功能，而且沃研究不懂这种代码。。。惭愧~

1. Sub yy()
   
2.   Dim d, arr, ar, i&, k&
   
3.   Set d = CreateObject("Scripting.Dictionary")
   
4.   arr = Range("A2", [a2].End(4)).Value
   
5.   For k = 1 To UBound(arr)
   
6.     ar = Split(arr(k, 1), ",")
   
7.     ReDim br(0 To UBound(ar))
   
8.     For i = 0 To UBound(ar)
   
9.       br(i) = Int(ar(i))
   
10.     Next
    
11.     For i = 0 To UBound(ar)
    
12.       ar(i) = Application.Small(br, i + 1)
    
13.       d(ar(i)) = ""
    
14.     Next
    
15.     arr(k, 1) = Join(d.keys, ",")
    
16.     d.RemoveAll
    
17.   Next
    
18.   [f2].Resize(UBound(arr), 1) = arr
    
19. End Sub

复制代码

宝贝万岁

paciguard 发表于 2017-8-13 09:11
结果写到D列了。。。
Sub 按钮1_Click()
Dim a, b()

效果很好，好理解，谢谢了

宝贝万岁

yaozong 发表于 2017-8-13 11:02

感谢，类型不匹配，br(i) = int(ar(i)) 改为 br(i) = Val(ar(i)) 就ok了，又学了一种方法，开森~