Можно UDF (бонусом макрос)
В ячейке 'A8' прописан путь к xml файлу
Скрытый текст |
---|
Код |
---|
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
|
|
П.С. Добавил в файл парсинг штатной функций ФИЛЬТР.XML