Public Sub test()
    Dim pSheet As Worksheet, tmp As String
    Dim LRow As Long, vData As Variant
    Dim pReg As Object, i As Long, pItem As Object
    
    Set pSheet = ActiveSheet
    LRow = pSheet.Cells(pSheet.Rows.Count, 1).End(xlUp).Row
    vData = pSheet.Range(pSheet.Cells(1, 1), pSheet.Cells(LRow, 1)).Value
    
    vData(1, 1) = "order"
    Set pReg = CreateObject("VBScript.RegExp")
    pReg.Global = True: pReg.Pattern = "\d+"
    For i = 2 To UBound(vData)
        tmp = pReg.Replace(vData(i, 1), "|||")
        For Each pItem In pReg.Execute(vData(i, 1))
           tmp = Replace$(tmp, "|||", Format$(CLng(pItem.Value), "0000"), 1, 1)
        Next
        vData(i, 1) = tmp
    Next
    pSheet.Range("A1").End(xlToRight).Offset(0, 1).Resize(UBound(vData), 1).Value = vData
End Sub

Option Explicit
'===================================================================================================================
'Приведение чисел, смешанных с текстом в формат для сортировки (вариант для "умных" таблиц)
'Принцип: создаёт справа от столбца с шифром столбец, который заполняется шифрами, отформатированными для корректной сортировки
'Варианты работы: 1. форматировать только числа в шифре 2. оставить только отформатированные числа в шифре
'Автор: Андрей VG
'Дополнения: Jack Famous
'Тема на форуме: https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=101942&TITLE_SEO=101942-korrektnaya-sortirovka-ranzhirovanie-chisel-smeshannykh-s-tekstom
'===================================================================================================================
Sub SortableCode_VG()
Const numFormat = "0000" 'числовой формат для замены
Dim pRegNum As Object, pRegNoNum As Object, pItem As Object
Dim pLO As ListObject, pLCol As ListColumn
Dim vData
Dim OnlyNum As Boolean
Dim choose As Byte
Dim col%
Dim i&
Dim tmp$, str$

On Error GoTo ex
col = Application.InputBox("Укажите любую ячейку столбца ШИФРА:", "Запрос данных.", Selection.Address, Type:=8)(1).Column
choose = MsgBox("Оставить только числа?", vbYesNoCancel + vbQuestion + vbDefaultButton2)
    Select Case choose
        Case vbYes: OnlyNum = True
        Case vbNo: OnlyNum = False
        Case vbCancel: GoTo ex
    End Select

Application.ScreenUpdating = 0
On Error GoTo er

Set pLO = ActiveSheet.ListObjects(1)
vData = pLO.ListColumns(col).DataBodyRange.Value 'забираем в массив столбец шифров

Set pRegNum = CreateObject("VBScript.RegExp")
pRegNum.Global = True: pRegNum.Pattern = "\d+" 'отбираем числа

Set pRegNoNum = CreateObject("VBScript.RegExp")
pRegNoNum.Global = True: pRegNoNum.Pattern = "[^0-9]" 'отбираем НЕчисла

str = "|||"
    For i = 1 To UBound(vData) 'для каждой ячейки с шифром
        tmp = pRegNum.Replace(vData(i, 1), str) 'заменяем найденные числа на временную строку
            For Each pItem In pRegNum.Execute(vData(i, 1)) 'для каждого из найденных (в ячейке шифра) чисел…
                tmp = Replace$(tmp, str, Format$(CLng(pItem.Value), numFormat), 1, 1) 'меняем во временную строку обратно на найденное число, но уже в текстовом формате с ведущими нулями (первое найденное и одно вхождение)
            Next pItem
        If OnlyNum = True Then tmp = pRegNoNum.Replace(tmp, " "): tmp = Application.WorksheetFunction.Trim(tmp)
        vData(i, 1) = CStr(tmp) 'пишем в массив готовую текстовую строку
    Next i

Set pLCol = pLO.ListColumns.Add(col + 1) 'создаём столбец справа от столбца шифров
pLCol.DataBodyRange.Value = vData 'выгружаем массив в созданный столбец

GoTo fin
ex:
MsgBox "Отмена выполнения…", vbInformation, "EXIT"

GoTo fin
er:
MsgBox "КРИТИЧЕСКАЯ ОШИБКА!", vbCritical, "FATAL ERROR"

fin:
On Error GoTo 0
Application.ScreenUpdating = 1
End Sub