多小数点，进行数字排序

ning84

能有这么简单吗？
把第一个小数点前的数字分离，进行排序就是可以？

数论

拆开4部分再来排序吧，用分列功能，再用多条件排序即可

ning84

菜鸟学习体会，数组+字典等方法很难实现，不可能比Excel内置的排序功能效率高。

1. Sub ls()
   
2.    Dim Sht As Worksheet
   
3.        Set Sht = Sheet2
   
4.    Dim Rng As Range, oRng As Range
   
5.       Set Rng = Cells(4, 1).CurrentRegion
   
6.       'Debug.Print Rng.Address
   
7.       ''
   
8.       For ii = 1 To Rng.Rows.Count
   
9.           s = Split(Rng(ii, 1), ".")
   
10.           Rng(ii, 4) = Rng(ii, 1)
    
11.           Rng(ii, 5) = Rng(ii, 2)
    
12.           For jj = 0 To UBound(s)
    
13.               Rng(ii, 6 + jj) = s(jj)
    
14.           Next jj
    
15.       Next ii
    
16.       
    
17.       Set Rng = Rng(ii - 1, jj).CurrentRegion
    
18.       With Sht.Sort
    
19.         With .SortFields
    
20.              .Clear
    
21.              For jj = 3 To Rng.Columns.Count
    
22.                   Set oRng = Rng(1, jj).Resize(Rng.Rows.Count, 1)
    
23.                   'Debug.Print oRng.Address(RowAbsolute:=False, ColumnAbsolute:=False)
    
24.                   Debug.Print oRng.Address(0, 0)
    
25.                   .Add Key:=Range(oRng.Address(0, 0)) _
    
26.                           , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
27.              Next jj
    
28.         End With
    
29.         .SetRange Rng
    
30.         .Header = xlGuess
    
31.         .MatchCase = False
    
32.         .Orientation = xlTopToBottom
    
33.         .SortMethod = xlPinYin
    
34.         .Apply
    
35.       
    
36.       End With
    
37. 
    
38.       ''
    
39. End Sub

复制代码

1. Sub ll()
   
2.    Dim Rng As Range, SortRng As Range
   
3.        With Sheet2
   
4.            Set Rng = .Cells(4, 1).CurrentRegion
   
5.            Set SortRng = .Cells(4, 1).Resize(Rng.Rows.Count, 1)
   
6.            Debug.Print Rng.Address, SortRng.Address
   
7.            SpecialCharacterSeparation Rng, SortRng, ".", 8
   
8.        End With
   
9. End Sub
   
10. 
    
11. Function SpecialCharacterSeparation(ManyRng As Range, SortRng As Range, Separation As String, Col As Integer)
    
12.      Dim Sht As Worksheet
    
13.          Set Sht = ManyRng.Parent
    
14.      Dim Rng As Range, tmpSortRng As Range
    
15.          ''
    
16.          For ii = 1 To ManyRng.Rows.Count
    
17.              s = Split(SortRng(ii, 1), Separation)
    
18.              For jj = 0 To UBound(s)
    
19.                  Sht.Cells(ManyRng.Row + ii - 1, Col + jj) = s(jj)
    
20.              Next jj
    
21.          Next ii
    
22.          ''
    
23.       Set Rng = Sht.Cells(ManyRng.Row + ii - 1 - 1, Col + jj - 1).CurrentRegion
    
24.       Set tmpSortRng = Rng
    
25.       Set Rng = Sht.Cells(ManyRng.Row, 1).Resize(Rng.Rows.Count, Rng.Column + Rng.Columns.Count - 1)
    
26.       Debug.Print Rng.Address
    
27.       Stop
    
28.       With Sht.Sort
    
29.         With .SortFields
    
30.              .Clear
    
31.              For jj = 1 To tmpSortRng.Columns.Count
    
32.                   Set oRng = tmpSortRng(1, jj).Resize(Rng.Rows.Count, 1)
    
33. 
    
34.                   .Add Key:=Range(oRng.Address(0, 0)) _
    
35.                           , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
36.              Next jj
    
37.         End With
    
38.         .SetRange Rng
    
39.         .Header = xlGuess
    
40.         .MatchCase = False
    
41.         .Orientation = xlTopToBottom
    
42.         .SortMethod = xlPinYin
    
43.         .Apply
    
44.       End With
    
45.          
    
46. End Function
    

复制代码

huiren_renli

排序函数sort和sortby，版本要够

ning84

用数组方法，怎么想也没什么方法比Excel的多条件方法跟家简单方便。

1.       ''
   
2.       With Sht.Sort
   
3.         With .SortFields
   
4.              .Clear
   
5.              For jj = 1 To tmpSortRng.Columns.Count
   
6.                   Set oRng = tmpSortRng(1, jj).Resize(Rng.Rows.Count, 1)
   
7. 
   
8.                   .Add Key:=Range(oRng.Address(0, 0)) _
   
9.                           , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
   
10.              Next jj
    
11.         End With
    
12.         .SetRange Rng
    
13.         .Header = xlGuess
    
14.         .MatchCase = False
    
15.         .Orientation = xlTopToBottom
    
16.         .SortMethod = xlPinYin
    
17.         .Apply
    
18.       End With

复制代码

1. Private Sub ArraySort()
   
2.    Dim Arr(5)
   
3.     Arr(0) = Array(25, 9, 340, 1)
   
4.     Arr(1) = Array(32, 3, 574, 2)
   
5.     Arr(2) = Array(46, 2, 320, 3)
   
6.     Arr(3) = Array(87, 8, 376, 2)
   
7.     Arr(4) = Array(47, 0, 449, 1)
   
8.     Arr(5) = Array(52, 7, 677, 5)
   
9. Stop
   
10. End Sub

复制代码