Option Explicit

Sub main()
    Dim arr(), i&
    arr = Range("a1:b" & Cells(Rows.Count, "a").End(xlUp).Row).Value
    For i = 1 To UBound(arr)
        arr(i, 2) = Val(ikg(arr(i, 1)))
    Next i
    arr = MergeSortMultiDimens(arr, 2)
    [b1].Resize(UBound(arr), 1).Value = arr
End Sub
'======================================================
Private Function ikg(ByVal cell$)
 With CreateObject("VBScript.RegExp")
     .Global = True
     .Pattern = "\d+(?= кг)"
   If .test(cell) Then
     ikg = .Execute(cell)(0)
     ikg = Format(ikg, "000")
   Else
     ikg = ""
   End If
 End With
End Function
'=====================================================
Private Function MergeSortMultiDimens(arr, cl&)
'   ----------------------------
    Dim arr_b(), arr_c(), rw&
    Dim m&, n&, k&, l&, i&, j&, st&, fn&
'   ----------------------------
    st = LBound(arr, 2): fn = UBound(arr, 2)
    m = UBound(arr)
    If m > 1 Then
        n = m \ 2
        ReDim arr_b(1 To n, st To fn)
        For i = 1 To n
            For rw = st To fn
                arr_b(i, rw) = arr(i, rw)
        Next rw, i
        arr_b = MergeSortMultiDimens(arr_b, cl)
        k = m - n
        ReDim arr_c(1 To k, st To fn)
        For i = 1 To k
            For rw = st To fn
                arr_c(i, rw) = arr(n + i, rw)
        Next rw, i
        arr_c = MergeSortMultiDimens(arr_c, cl)
        i = 1: j = 1: l = 1
        Do While i <= n And j <= k
            If arr_b(i, cl) < arr_c(j, cl) Then
                For rw = st To fn
                    arr(l, rw) = arr_b(i, rw)
                Next rw
                i = i + 1
            Else
                For rw = st To fn
                    arr(l, rw) = arr_c(j, rw)
                Next rw
                j = j + 1
            End If
            l = l + 1
        Loop
        Do While i <= n
            For rw = st To fn
                arr(l, rw) = arr_b(i, rw)
            Next rw
            i = i + 1
            l = l + 1
        Loop
        Do While j <= k
            For rw = st To fn
                arr(l, rw) = arr_c(j, rw)
            Next rw
            j = j + 1
            l = l + 1
        Loop
    End If
    MergeSortMultiDimens = arr
End Function