Iを選択一般的なXMLコードにpublisher、preorderとcoverプロパティを追加するので、次のように試験するためのコードがある：ここ
<catalog>
<book id="bk101">
<author>Gambardella, Matthew</author>
<title>XML Developer's Guide</title>
<genre>Computer</genre>
<price>44.95</price>
<publish_date>2000-10-01</publish_date>
<description>An in-depth look at creating applications with XML.</description>
</book>
<book id="bk102">
<author>Ralls, Kim</author>
<title>Midnight Rain</title>
<genre>Fantasy</genre>
<price>5.95</price>
<preorder>2.49</preorder>
<publish_date>2000-12-16</publish_date>
<description>A former architect battles corporate zombies, an evil sorceress, and her own childhood to become queen of the world.</description>
</book>
<book id="bk103">
<author>Corets, Eva</author>
<title>Maeve Ascendant</title>
<genre>Fantasy</genre>
<price>5.95</price>
<preorder>1.99</preorder>
<publish_date>2000-11-17</publish_date>
<cover>case binding</cover>
<description>After the collapse of a nanotechnology society in England, the young survivors lay the foundation for a new society.</description>
</book>
<book id="bk104">
<publisher>Pearson</publisher>
<author>Corets, Eva</author>
<title>Oberon's Legacy</title>
<genre>Fantasy</genre>
<price>5.95</price>
<publish_date>2001-03-10</publish_date>
<description>In post-apocalypse England, the mysterious agent known only as Oberon helps to create a new life for the inhabitants of London. Sequel to Maeve Ascendant.</description>
</book>
</catalog>
を処理することを可能にする可能な解決策のいずれかを示す一例ですXMLとして格納されたテーブルのようなデータを取得し、ヘッダー付きのテーブルを表す2次元配列を取得します。提供されたXPathセレクタに従ってアイテムを処理し、アイテムの子ノードをプロパティとみなし、プロパティ名と値を抽出し、右の列にプロパティを配置します。
このアプローチは、配列を使用するコードを手直しした方が良いような場合のために、大規模なXMLデータのための非常に遅くてもよい辞書を使用する：私のために次のように得られた出力である
Option Explicit
Sub Test()
Dim strBooksXML As String
Dim arrBooks() As Variant
' get certain XML code
strBooksXML = MyXMLData
' pass XML code and XPath selector to retrieve table-form array
arrBooks = ConvertXMLToArray(strBooksXML, "//catalog/book")
' resulting array output
Output Sheets(1), arrBooks
End Sub
Function ConvertXMLToArray(strXML As String, strItemSelector As String) As Variant()
Dim objDOMDocument As Object
Dim objPrpIdx As Object
Dim objPrpVal As Object
Dim lngItemNumber As Long
Dim colItems As Object
Dim objItem As Variant
Dim objItemProperty As Variant
Dim strPrev As String
Dim strName As String
Dim lngIndex As Long
Dim arrItems() As Variant
Dim varPrpName As Variant
Dim varItemIndex As Variant
Set objDOMDocument = CreateObject("MSXML2.DOMDocument")
If Not objDOMDocument.LoadXML(strXML) Then
Err.Raise objDOMDocument.parseError.ErrorCode, , objDOMDocument.parseError.reason
End If
Set objPrpIdx = CreateObject("Scripting.Dictionary") ' dictionary of property order indexes
Set objPrpVal = CreateObject("Scripting.Dictionary") ' dictionary of property values
lngItemNumber = 1
Set colItems = objDOMDocument.SelectNodes(strItemSelector)
For Each objItem In colItems
strPrev = "" ' previous processed property name
For Each objItemProperty In objItem.ChildNodes
strName = objItemProperty.BaseName ' name of the property being processed
If Not objPrpIdx.Exists(strName) Then ' no such property yet
If strPrev = "" Then ' the property is the first
lngIndex = 0
Else ' the property placed after another
lngIndex = objPrpIdx(strPrev) + 1
End If
' increase all indexes that are greater or equal to processing property assigned index
' i. e. shift existing properties to insert new one
For Each varPrpName In objPrpIdx
If objPrpIdx(varPrpName) >= lngIndex Then objPrpIdx(varPrpName) = objPrpIdx(varPrpName) + 1
Next
' add new property name to dictionary of property order indexes with assigned index
objPrpIdx(strName) = lngIndex
' add new property name to dictionary of property values, instantiate subdictionary of values
Set objPrpVal(strName) = CreateObject("Scripting.Dictionary")
End If
objPrpVal(strName)(lngItemNumber) = objItemProperty.Text ' put property value with item index to the subdictionary
strPrev = strName ' reassign previous property name
Next
lngItemNumber = lngItemNumber + 1
Next
' rebuild dictionaries into 2d array for further output to worksheet
ReDim arrItems(lngItemNumber - 1, objPrpIdx.Count - 1)
For Each varPrpName In objPrpIdx ' process each
arrItems(0, objPrpIdx(varPrpName)) = varPrpName ' put property name to header
For Each varItemIndex In objPrpVal(varPrpName) ' process each item having the property
arrItems(varItemIndex, objPrpIdx(varPrpName)) = objPrpVal(varPrpName)(varItemIndex)
Next
Next
ConvertXMLToArray = arrItems
End Function
Sub Output(objSheet As Worksheet, arrCells() As Variant)
With objSheet
.Select
.Cells.Delete
With .Range(.Cells(1, 1), Cells(UBound(arrCells, 1) + 1, UBound(arrCells, 2) + 1))
.NumberFormat = "@"
.Value = arrCells
End With
.Columns.AutoFit
End With
With ActiveWindow
.SplitColumn = 0
.SplitRow = 1
.FreezePanes = True
End With
End Sub
Function MyXMLData()
Dim strXML
strXML = _
"<catalog>"
strXML = strXML & _
"<book id=""bk101"">" & _
"<author>Gambardella, Matthew</author>" & _
"<title>XML Developer's Guide</title>" & _
"<genre>Computer</genre>" & _
"<price>44.95</price>" & _
"<publish_date>2000-10-01</publish_date>" & _
"<description>An in-depth look at creating applications " & _
"with XML.</description>" & _
"</book>"
strXML = strXML & _
"<book id=""bk102"">" & _
"<author>Ralls, Kim</author>" & _
"<title>Midnight Rain</title>" & _
"<genre>Fantasy</genre>" & _
"<price>5.95</price>" & _
"<preorder>2.49</preorder>" & _
"<publish_date>2000-12-16</publish_date>" & _
"<description>A former architect battles corporate zombies, " & _
"an evil sorceress, and her own childhood to become queen " & _
"of the world.</description>" & _
"</book>"
strXML = strXML & _
"<book id=""bk103"">" & _
"<author>Corets, Eva</author>" & _
"<title>Maeve Ascendant</title>" & _
"<genre>Fantasy</genre>" & _
"<price>5.95</price>" & _
"<preorder>1.99</preorder>" & _
"<publish_date>2000-11-17</publish_date>" & _
"<cover>case binding</cover>" & _
"<description>After the collapse of a nanotechnology " & _
"society in England, the young survivors lay the " & _
"foundation for a new society.</description>" & _
"</book>"
strXML = strXML & _
"<book id=""bk104"">" & _
"<publisher>Pearson</publisher>" & _
"<author>Corets, Eva</author>" & _
"<title>Oberon's Legacy</title>" & _
"<genre>Fantasy</genre>" & _
"<price>5.95</price>" & _
"<publish_date>2001-03-10</publish_date>" & _
"<description>In post-apocalypse England, the mysterious " & _
"agent known only as Oberon helps to create a new life " & _
"for the inhabitants of London. Sequel to Maeve " & _
"Ascendant.</description>" & _
"</book>"
strXML = strXML & _
"</catalog>"
MyXMLData = strXML
End Function
辞書の代わりにlike here with JSON processingと入力します。
私の提案は、すべてのトップレベルのXMLノード（ 'book'ノード）をループし、すべての可能な子ノードの辞書を作成することです。基本的にはテーブルの列になるノードのスーパーセットを作成します。次に、リストを2回目に渡り、各ブックノードのデータを該当する列に追加します。新しく発生した子ノードを既存のデータの右側に新しい列として追加することで、これを1回のパスで実行できます。 – PeterT
こんにちはピーター、はいこれはまさに私が心に留めていることです。主な問題は、私が独自のセレクタの正しい構文、VBAなどを使ってXMLオブジェクトを処理する方法を知らないので、ブックノードをループする方法がわからないことです。そして、私はそのような情報をオンラインで見つけることに失敗しました。 – heikeke
[この回答]（http://stackoverflow.com/a/20022152/4717755）を見てください。それはあなたがしたいことを正確に行います。 – PeterT