问排序数据格式为9.9.9的表头行

EN

Sub Table1Sort()
    Dim i As Long
    Dim rg As Range, cl As Range
    Dim parts As Variant
    Dim fmt As String, id As String

    fmt = String(4, "0")                                        'in this case 4 seems to be the max lenght of number parts, adjust as needed
    Set rg = Range("A1:C5")                                     'your range to get sorted - adjust to the correct address

    For Each cl In rg.Rows(1).Cells                             'Transform numbers into a sort string, unless blank
        If cl <> "" Then
            id = ""
            parts = Split(cl.Text, ".")                             'Split into parts by numbers, pad with leading zeroes and concatenate with a separator
            For i = 0 To UBound(parts)
                id = id & "-" & Format(CInt(parts(i)), fmt)
            Next i
            id = Mid(id, 2)                                         'Remove leading separator
            cl.Value = id                                           'Put into cell
        End If
    Next cl

    ActiveWorkbook.Worksheets("Table1").Sort.SortFields.Clear                       'Do the sorting
    ActiveWorkbook.Worksheets("Table1").Sort.SortFields.Add2 Key:=rg.Rows(1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Table1").Sort
        .SetRange rg
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

    For Each cl In rg.Rows(1).Cells                           'Transform sort strings back to original
        If cl <> "" Then
            id = ""
            parts = Split(cl.Text, "-")
            For i = 0 To UBound(parts)
                id = id & "." & CInt(parts(i))
            Next i
            id = Mid(id, 2)
            cl.Value = id
        End If
    Next cl

End Sub

Option Explicit


Sub Table1Sort()
    Dim i As Integer
    Dim iRows As Integer
    Dim iLen As Integer
    Dim Arr() As Variant

    ActiveSheet.Range("d3:e5").Select  'I randomly entered the values to be sorted in a column here.

    iRows = Selection.Rows.Count 'Figure out how many items I'm dealing with.
    Arr = Range("d3:e5").Value2  'Write them to an array. I include the column next to the data as a placeholder.

    For i = 1 To iRows  'Strip periods and fill/overwrite 2nd column of array
        Arr(i, 2) = Replace(Arr(i, 1), ".", "")
        If Len(Arr(i, 2)) > iLen Then iLen = Len(Arr(i, 2))
    Next i

    For i = 1 To iRows 'Pad with trailing zeros
        Do While Len(Arr(i, 2)) < iLen
            Arr(i, 2) = Arr(i, 2) & "0"
        Loop
    Next i

    QuickSortArray Arr, , , 2  'Call the sort found here: https://stackoverflow.com/a/5104206/12000364

    For i = 1 To iRows  'Write the results out across columns. I randomly start at column F.
        Cells(1, 5 + i) = Arr(i, 1)
    Next i

End Sub

Sub Table1Sort()
    Dim i As Long
    Dim rg As Range, cl As Range
    Dim parts As Variant
    Dim fmt As String, id As String

    fmt = String(5, "0")                                        
    Set rg = Tabelle1.Range("B9:Q28")                          

    For Each cl In rg.Rows(1).Cells                             
        If cl <> "" Then
            id = ""
            parts = Split(cl.Text, ".")                             
            For i = 0 To UBound(parts)
                id = id & "-" & Format(CInt(parts(i)), fmt)
            Next i
            id = Mid(id, 2)                                         
            cl.Value = id                                           
        End If
    Next cl


    Tabelle1.Sort.SortFields.Clear                                                  
    Tabelle1.Sort.SortFields.Add Key:=rg.Rows(1) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With Tabelle1.Sort
        .SetRange rg
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With

    Tabelle1.Range("B39:Q39").ClearContents
    Tabelle1.Range("B44:Q44").ClearContents


    For Each cl In rg.Rows(1).Cells                           
        If cl <> "" Then
            id = ""
            parts = Split(cl.Text, "-")
            For i = 0 To UBound(parts)
                id = id & "." & CInt(parts(i))
            Next i
            id = Mid(id, 2)
            cl.Value = id
        End If
    Next cl
End Sub