Function XML_IFS(iPath$, Node1$, iCond$, Node2$)
'iPath - путь к xml файлу
'Node1 - название узла с условием
'iCond - условие
'Node2 - название узла с нужным свойством
Dim objXML As Object
Dim colNodes As Object
Dim pNodes
Dim iKey, iTmp
Set objXML = CreateObject("MSXML2.DOMDocument")
objXML.Load iPath
Set colNodes = objXML.getElementsByTagName(Node1)
  For Each iKey In colNodes
    If iKey.Text = iCond Then
      Set pNode = iKey.ParentNode.ChildNodes
        For Each iTmp In pNode
          If iTmp.BaseName = Node2 Then
            XML_IFS = iTmp.Text
            Exit For
          End If
        Next
    End If
  Next
  If IsEmpty(XML_IFS) Then XML_IFS = xlErrNA
End Function

Sub macro_XML_IFS()
Dim iFile$
Dim objXML As Object
Dim colNodes As Object
Dim iTbl As ListObject
Dim iCl As Range
Dim iKey
Dim arr()
Set objXML = CreateObject("MSXML2.DOMDocument")
iFile = "D:\DEVELOP\Форум\Excel\XML пример.xml" 'путь к файлу .xml
objXML.Load iFile
Set iTbl = Worksheets("Лист1").ListObjects("Таблица1")
ReDim arr(1 To iTbl.HeaderRowRange.Count, 1 To 1)
For Each iCl In iTbl.HeaderRowRange.Cells
  I = I + 1
  Set colNodes = objXML.getElementsByTagName(iCl)
  If UBound(arr, 2) < colNodes.Length Then ReDim Preserve arr(LBound(arr, 1) To UBound(arr, 1), LBound(arr, 2) To colNodes.Length)
  For Each iKey In colNodes
    J = J + 1
    arr(I, J) = iKey.Text
  Next
  J = 0
Next
Worksheets("Лист1").Range("F2").Resize(UBound(arr, 2), UBound(arr, 1)) = Application.Transpose(arr)
End Sub

Function SPLITSYMBOL(iVal)
Dim arrLet(), arr()
Dim dic As Object
Dim iKey
Dim N&
On Error Resume Next
iVal = Trim(Str(iVal))
If IsNumeric(Mid(iVal, Len(iVal), 1)) Then iVal = iVal & 0
If Len(iVal) < 4 Then iVal = String(4 - Len(iVal), "0") & iVal
arrLet = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", "л", _
                "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", _
                "щ", "ъ", "ы", "ь", "э", "ю", "я")
Set dic = CreateObject("Scripting.Dictionary")
ReDim arr(1 To 1, 1 To Len(iVal))
For Each iKey In arrLet
  N = N + 1
  dic.Add iKey, N
Next
For N = UBound(arr, 2) To 1 Step -1
  If dic.Exists(Mid(iVal, N, 1)) Then
    arr(1, N) = dic(Mid(iVal, N, 1))
  Else
    arr(1, N) = Mid(iVal, N, 1)
  End If
Next
SPLITSYMBOL = arr
End Function