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

Sub main()
    Dim xml As MSXML2.DOMDocument60
    Dim sb$
    Dim xNode As IXMLDOMElement
    Dim xRoot As IXMLDOMElement
    Set xml = New MSXML2.DOMDocument60
    sb = Chr(62) & vbNewLine & Chr(60)
    xml.appendChild xml.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")
    Set xRoot = xml.createElement("Document")
    xRoot.setAttribute "xmlns:xsi", "http://blabla/2001/blablabla"
    xRoot.setAttribute "xmlns:dtr", "http://blabla.ru/blabla/blabla"
    Set xNode = xml.createElement("Rows")
    xNode.appendChild xml.createElement("row")
    xNode.appendChild xml.createElement("row")
    xNode.appendChild xml.createElement("row")
    xRoot.appendChild xNode
    xml.appendChild xRoot
    xml.LoadXML Replace(xml.xml, "><", sb)
   MsgBox xml.xml
End Sub

<?xml version="1.0"?>
<Document xmlns:xsi="http://blabla/2001/blablabla" xmlns:dtr="http://blabla.ru/blabla/blabla">
    <Rows>
        <row/>
        <row/>
        <row/>
    </Rows>
</Document>

<?xml version="1.0"?>
<dtr:Document xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:dtr="http://blabla.ru/blabla/blabla">
    <dtr:Rows>
        <dtr:row/>
        <dtr:row/>
        <dtr:row/>
    </dtr:Rows>
</dtr:Document>

Sub main()
    Dim xml As MSXML2.DOMDocument60
    Dim sb$
    Dim xNode As IXMLDOMElement
    Dim xRoot As IXMLDOMElement
    Set xml = New MSXML2.DOMDocument60
    sb = Chr(62) & vbNewLine & Chr(60)
    xml.appendChild xml.createProcessingInstruction("xml", "version='1.0' encoding='utf-8'")
    Set xRoot = xml.createElement(getNS & "Document")
    xRoot.setAttribute "xmlns:xsi", "http://blabla/2001/blablabla"
    xRoot.setAttribute "xmlns:dtr", "http://blabla.ru/blabla/blabla"
    Set xNode = xml.createElement(getNS & "Rows")
    xNode.appendChild xml.createElement(getNS & "row")
    xNode.appendChild xml.createElement(getNS & "row")
    xNode.appendChild xml.createElement(getNS & "row")
    xRoot.appendChild xNode
    xml.appendChild xRoot
    xml.LoadXML Replace(xml.xml, "><", sb)
    MsgBox xml.xml
End Sub

Function getNS()
    getNS = "dtr:"
End Function