用vb做到同行数据去重复后排序

chxw68

tandke 发表于 2018-9-10 18:59
谢谢你的回复，好像还是有点问题，当一行里只有一个数时，它排序出来竞然一个数都没有

我试了没这种情况，你再仔细试试。

tandke

chxw68 发表于 2018-9-10 19:18
我试了没这种情况，你再仔细试试。

大师你可以在一行数据中间输入一个数，我这里试着当一行有一个数时不能排序

chxw68

请看下图。

不知道为什么

tandke 发表于 2018-9-10 19:34
大师你可以在一行数据中间输入一个数，我这里试着当一行有一个数时不能排序

应该一开始就把附件多种场景模拟好，否则浪费褚老师的时间啊
如图，是你需要的效果？

不知道为什么

tandke 发表于 2018-9-10 19:34
大师你可以在一行数据中间输入一个数，我这里试着当一行有一个数时不能排序

参考

duquancai

tandke 发表于 2018-9-10 18:59
谢谢你的回复，好像还是有点问题，当一行里只有一个数时，它排序出来竞然一个数都没有

代码如下，请测试》》》》》》》

1. Sub main()
   
2.     Dim arr, brr(), s$, kr
   
3.     arr = Range("a2:k" & Cells(Rows.Count, 1).End(3).Row)
   
4.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
5.     For i = 1 To UBound(arr)
   
6.         s = Empty
   
7.         For j = 1 To UBound(arr, 2)
   
8.             If Len(arr(i, j)) Then s = s & "," & "'" & arr(i, j) & "'"
   
9.         Next
   
10.         If s <> Empty Then
    
11.             kr = Split(mySort(s), ",")
    
12.             For j = 0 To UBound(kr)
    
13.                 brr(i, j + 1) = kr(j)
    
14.             Next
    
15.         End If
    
16.     Next
    
17.     Range("n2").Resize(UBound(arr), UBound(arr, 2)) = brr
    
18. End Sub
    
19. Function mySort(ByVal s As String) As String
    
20.     Dim js As Object, i&, D As Object
    
21.     Set D = CreateObject("htmlfile"): Set js = D.parentWindow
    
22.     js.execScript "o={};b=" & "[" & Mid(s, 2) & "]" & ";for(i=0;i<b.length;i++)o[b[i]]=0;"
    
23.     js.execScript "a=[];j=0;for(k in o)a.push(k);a.sort(function (x,y){return x-y});"
    
24.     mySort = js.eval("a")
    
25. End Function

复制代码

tandke

不知道为什么 发表于 2018-9-10 19:50
参考

你好，你的代码可以说很全面了，但我加入更多的数据后就出现溢出了

tandke

duquancai 发表于 2018-9-10 20:00
代码如下，请测试》》》》》》》

我都不知道说点啥好，有劳各位老师了

duquancai

tandke 发表于 2018-9-10 21:05
我都不知道说点啥好，有劳各位老师了

哎！我都不知道该说什么好呢？？？？？？？？？？？？？？？

duquancai

tandke 发表于 2018-9-10 21:05
我都不知道说点啥好，有劳各位老师了

你可是 08年 就注册论坛了！这么浅显的 也看不出来！我真服了！！！！请测试如下代码吧》》》》》》》》》》》》》》》》》

1. Sub main()
   
2.     Dim arr, brr(), s$, kr, r&
   
3.     r = Range("a:k").Find("*", , , , 1, 2).Row
   
4.     Range("n:x").Clear: arr = Range("a1:k" & r)
   
5.     ReDim brr(1 To r, 1 To UBound(arr, 2))
   
6.     For i = 1 To r
   
7.         s = Empty
   
8.         For j = 1 To UBound(arr, 2)
   
9.             If Len(arr(i, j)) Then s = s & "," & "'" & arr(i, j) & "'"
   
10.         Next
    
11.         If s <> Empty Then
    
12.             kr = Split(mySort(s), ",")
    
13.             For j = 0 To UBound(kr)
    
14.                 brr(i, j + 1) = kr(j)
    
15.             Next
    
16.         End If
    
17.     Next
    
18.     Range("n1").Resize(r, UBound(arr, 2)) = brr
    
19. End Sub
    
20. Function mySort(ByVal s As String) As String
    
21.     Dim js As Object, i&, D As Object
    
22.     Set D = CreateObject("htmlfile"): Set js = D.parentWindow
    
23.     js.execScript "o={};b=" & "[" & Mid(s, 2) & "]" & ";for(i=0;i<b.length;i++)o[b[i]]=0;"
    
24.     js.execScript "a=[];j=0;for(k in o)a.push(k);a.sort(function (x,y){return x-y});"
    
25.     mySort = js.eval("a")
    
26. End Function

复制代码