同一单元格内数字排序

yshcy

代码是提取了不重复的数字。现在想将I列的单元格内的数据，在I列各单元格内直接由小大到排序，谢谢

ykcbf1100

ArrayList法

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.8.28  同行排序,ArrayList法
   
2.     Application.ScreenUpdating = False
   
3.     Set List = CreateObject("System.Collections.ArrayList")
   
4.     r = Cells(Rows.Count, 1).End(3).Row
   
5.     arr = [a1].Resize(r, 9)
   
6.     For i = 2 To UBound(arr)
   
7.         List.Clear
   
8.         For j = 2 To UBound(arr, 2) - 1
   
9.             If Not List.Contains(arr(i, j)) Then List.Add arr(i, j)
   
10.         Next
    
11.         List.Sort
    
12.         zrr = List.toArray
    
13.         arr(i, 9) = Join(zrr, "，")
    
14.     Next
    
15.     [i1].Resize(r, 1) = Application.Index(arr, 0, 9)
    
16.     Application.ScreenUpdating = True
    
17.     MsgBox "OK！"
    
18. End Sub
    
19. 
    

复制代码

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, i&
   
    Application.ScreenUpdating = False
   
    ar = [A1].CurrentRegion.Value
    For i = 1 To UBound(ar)
        br = Split(ar(i, 9), ",")
        bSort1 br, 0, UBound(br), True
        ar(i, 9) = Join(br, ",")
    Next i
    [A1].CurrentRegion.Value = ar
   
    Application.ScreenUpdating = True
    Beep
End Sub


Function bSort1(ByRef ar, ByVal iFirst&, ByVal iLast&, _
    Optional ByVal isOrder As Boolean = True)
    Dim i&, j&, vTemp
   
    For i = iFirst To iLast - 1
        For j = iFirst To iLast + iFirst - 1 - i
            If ar(j) <> ar(j + 1) Then
                If ar(j) < ar(j + 1) Xor isOrder Then
                    vTemp = ar(j)
                    ar(j) = ar(j + 1)
                    ar(j + 1) = vTemp
                End If
            End If
        Next j
    Next i
End Function

gwjkkkkk

...............

今铭昔

65861954

抽个热闹

1. ，用的冒泡排序！
   
2. '排序代码
   
3. Sub test1()
   
4. For m = 2 To 7
   
5.     arr = Split(Range("i" & m).Value, ",")
   
6.      For i = LBound(arr) To UBound(arr) - 1
   
7.         For j = i + 1 To UBound(arr)
   
8.             If arr(i) > arr(j) Then
   
9.                 ' 交换元素
   
10.                 temp = arr(i)
    
11.                 arr(i) = arr(j)
    
12.                 arr(j) = temp
    
13.             End If
    
14.         Next j
    
15.     Next i
    
16.     Range("j" & m).Resize(1, UBound(arr) + 1) = arr
    
17. Next m
    
18. End Sub
    

复制代码

无关岁月

副本不重复开奖号码.7z (14.97 KB, 下载次数: 8)

2024-8-28 20:36 上传

点击文件名下载附件

tigertc

如果都是整数的话，可以这样：

1. Sub test1()
   
2. Dim d1, d2, arr, i&, j&
   
3. 
   
4. Set d1 = CreateObject("scripting.dictionary")
   
5. Set d2 = CreateObject("scripting.dictionary")
   
6. 
   
7. arr = [a1].CurrentRegion.Value
   
8. For i = 2 To UBound(arr)
   
9.     For j = 2 To UBound(arr, 2) - 1
   
10.         d1(arr(i, j)) = ""
    
11.     Next j
    
12.     mymin = Application.Min(d1.keys)
    
13.     mymax = Application.Max(d1.keys)
    
14.     For j = mymin To mymax
    
15.         If d1.exists(j) Then d2(j) = ""
    
16.     Next j
    
17.     arr(i, UBound(arr, 2)) = Join(d2.keys, ",")
    
18.     d2.RemoveAll
    
19.     d1.RemoveAll
    
20. Next i
    
21. [a1].Resize(UBound(arr), UBound(arr, 2)) = arr
    
22. End Sub

复制代码

leolee82

Sub ykcbf2()
    r = Cells(Rows.Count, 1).End(3).Row
    arr = [a1].Resize(r, 9)
   
    Dim arrT(0 To 9) As String, ar

    For i = 2 To UBound(arr)
        For j = 0 To 9
            arrT(j) = "A"
        Next
        For j = 2 To UBound(arr, 2) - 1
            arrT(arr(i, j)) = arr(i, j)
        Next
        
        arr(i, 9) = Join(Filter(arrT, "A", False), "，")
    Next
    [i1].Resize(r, 1) = Application.Index(arr, 0, 9)
End Sub