Option Explicit

Const SEPAR_SECTIONS As String = "."
Const SEPAR_PARTS As String = "_"

Public bDebug As Boolean

Sub Squadra_Unita()

    Dim r As Range
    Set r = Cells(1, 3).CurrentRegion

    Dim ceLL As Range

    For Each ceLL In r

        With ceLL

            .Value = Prep_2_Sort_Natural( _
                     Len_Max, "0", SEPAR_SECTIONS, _
                     Part_Left(.Value, SEPAR_PARTS)) & _
                     SEPAR_PARTS & _
                     Part_Rigt(.Value, SEPAR_PARTS)

        End With
    Next
    
    r.Sort Key1:=r.Cells(1, 1), Order1:=xlAscending, Header:=xlGuess
    
End Sub

Function Len_Max( _
         Optional s As String) _
         As Long
    ' code test coverage
    ' потом будет искать макс длину строки для определения
    ' колва лидирующих нулей

    Len_Max = 2

End Function

Function Prep_2_Sort_Natural( _
         lLen As Long, _
         lead As String, _
         separ As String, _
         s As String) _
         As String
    ' code test coverage
    ' получаю строку вида 1.45.6
    ' делаю из неё 01.45.06

    If InStr(s, separ) > 0 Then

        Prep_2_Sort_Natural = Join( _
                    A1_Erection_Left( _
                    Split(s, separ), _
                    lLen, lead), _
                    separ)
    Else

        Prep_2_Sort_Natural = s

    End If
End Function

Function Part_Left( _
         msg As String, _
         submsg As String) _
         As String
    ' code test coverage

    If InStr(msg, submsg) > 0 Then

        Part_Left = Left$(msg, InStr(msg, submsg) - 1)

    Else

        Part_Left = msg

    End If

End Function

Function Part_Rigt( _
         msg As String, _
         submsg As String) _
         As String
    ' code test coverage

    If InStr(msg, submsg) > 0 Then

        Part_Rigt = Right$(msg, Len(msg) - _
                    InStr(msg, submsg) - _
                    Len(submsg) + 1)

    Else

        Part_Rigt = msg

    End If
End Function

Function A1_Erection_Left( _
         a1 As Variant, _
         lLen As Long, _
         symb As String) _
         As Variant

    ' code test coverage

    Dim lCol As Long

    For lCol = LBound(a1) To UBound(a1)

        a1(lCol) = Erection_Left( _
                   CStr(a1(lCol)), _
                   lLen, symb)

    Next

    A1_Erection_Left = a1

End Function

Function Erection_Left( _
         s As String, _
         lLen As Long, _
         symb As String) _
         As String
    ' code test coverage
    ' увеличить строку повтором symb слева

    If Len(symb) < 1 Then

        Erection_Left = s

    Else

        Erection_Left = String$(lLen - Len(s), symb) & s

    End If
End Function