質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
XML

XMLは仕様の1つで、マークアップ言語群を構築するために使われています。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

3回答

2369閲覧

VBA XML 複数階層 汎用化

sigret

総合スコア45

XML

XMLは仕様の1つで、マークアップ言語群を構築するために使われています。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2018/03/29 07:05

現在VBAでExcelシートの内容をXML出力するマクロを作成しています。
マクロ実行で出力自体は可能なのですがこれから列(階層)が増えていく予定らしく下記のデータ取得時のコードを階層がいくつあっても大丈夫なように汎用化対応が必要なのですがどのように書けばよいのでしょう・・。

「今どこの階層にあるデータを取得している」をループ処理で記述すれば良いと考えていますが記述の仕方がわからないです・・。

よろしくお願いします・・。

VBA

1 Dim x As String 2 Dim y As String 3 Dim Row As Integer 4 Dim Low As Integer 5 Dim Col As Integer 6 Dim Col1 As Integer 7 Dim xmlObj As MSXML2.IXMLDOMNode 8 Dim xmlObj1 As MSXML2.IXMLDOMNode 9 Dim xmlObj2 As MSXML2.IXMLDOMNode 10 Dim xmlObj3 As MSXML2.IXMLDOMNode 11 Dim xmlObj4 As MSXML2.IXMLDOMNode 12 Dim xmlObj5 As MSXML2.IXMLDOMNode 13 Dim xmlObj6 As MSXML2.IXMLDOMNode 14 Dim xmlObj7 As MSXML2.IXMLDOMNode 15 Dim xmlDoc As MSXML2.DOMDocument60 16 17(中略) 18 19 'データ取得 20Do While Col < Col1 21 If TargetWorkbook.Worksheets(SheetName).Cells(Row, Col).Value <> "" Then 22 x = TargetWorkbook.Worksheets(SheetName).Cells(Row, Col1).Value 23 y = TargetWorkbook.Worksheets(SheetName).Cells(Row, Col2).Value 24 If Col = 2 Then 25 Set xmlObj = xmlDoc.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) 26 xmlObj.Text = y 27 ElseIf Col = 3 Then 28 Set xmlObj1 = xmlObj.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) 29 xmlObj1.Text = y 30 ElseIf Col = 4 Then 31 Set xmlObj2 = xmlObj1.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) 32 xmlObj2.Text = y 33 ElseIf Col = 5 Then 34 Set xmlObj3 = xmlObj2.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) 35 xmlObj3.Text = y 36 ElseIf Col = 6 Then 37 Set xmlObj4 = xmlObj3.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) 38 xmlObj4.Text = y 39 ElseIf Col = 7 Then 40 Set xmlObj5 = xmlObj4.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) 41 xmlObj5.Text = y 42 ElseIf Col = 8 Then 43 Set xmlObj6 = xmlObj5.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) 44 xmlObj6.Text = y 45 ElseIf Col = 9 Then 46 Set xmlObj7 = xmlObj6.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) 47 xmlObj7.Text = y 48 End If 49 50 Col = 2 51 Row = Row + 1 52 Else: Col = Col + 1 53 End If 54Loop

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Zuishin

2018/03/29 07:38

回答のついた質問を返事もせず何か月も放置しているのはなぜですか?
guest

回答3

0

DOMに詳しくないので具体的な実装方法は書けませんが、通常なら追加したい場所を探してそのオブジェクトを得たあと、そのオブジェクトに対して追加するんじゃないでしょうか。
全部のノードのオブジェクトを保持しておくのは非現実的です。

--
ちょっとだけ試してみました。
実際の実装には修正が必要かもしれませんが、こんな感じでしょうか。

VBA

1Dim x As String 2Dim y As String 3Dim Row As Integer 4Dim Col As Integer 5Dim Col1 As Integer 6Dim Col2 As Integer 7Dim r As Integer 8Dim xmlObj As MSXML2.IXMLDOMNode 9Dim xmlDoc As MSXML2.DOMDocument60 10Dim tag As String 11Dim ws As Worksheet 12 13(中略) 14 15Set ws = TargetWorkbook.Worksheets(SheetName) 16 17'データ取得 18Do While Col < Col1 19 If ws.Cells(Row, Col).Value <> "" Then 20 21 ' タグ名と値を取得 22 x = ws.Cells(Row, Col1).Value 23 y = ws.Cells(Row, Col2).Value 24 25 If Col = 2 Then 26 ' ルートに(を?)追加 27 Set xmlObj = xmlDoc.appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) 28 Else 29 ' 1つ上の階層のタグ名を取得 30 For r = Row - 1 To 1 Step -1 31 If ws.Cells(r, Col - 1).Value <> "" Then 32 tag = Cells(r, Col1).Value 33 Exit For 34 End If 35 Next 36 ' タグ名でエレメントを取得して、そのエレメントにノード追加 ※但し、同一タグ名が重複しない場合に限る 37 Set xmlObj = xmlDoc.getElementsByTagName(tag).Item(0).appendChild(xmlDoc.createNode(NODE_ELEMENT, x, "")) 38 End If 39 40 ' 追加したノードに値を登録 41 xmlObj.Text = y 42 43 Col = 2 44 Row = Row + 1 45 Else 46 Col = Col + 1 47 End If 48Loop 49'Debug.Print xmlDoc.XML 50End Sub

投稿2018/03/29 08:27

編集2018/03/30 00:15
ttyp03

総合スコア16996

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

オブジェクト型配列で対応できるかも。

Dim xmlObj() As MSXML2.IXMLDOMNode
Redim xmlObj(1 to 9)

投稿2018/03/29 08:15

ExcelVBAer

総合スコア1175

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

0

ベストアンサー

サンプルのプログラムは、<>"" のカラム位置で階層を決めているということでしょうかね?

【例】以下の場合、列1のchildが列2、列2のchildが列3
ノード名がcol1、値がcol2(固定)
|列1|列2|列3|列4|列5|…|col1|col2|
|:--|:--:|:--:|:--:|:--:|--:|
|* | | | | | |name1|value1|
| |* | | | | |name2|value2|
| | |* | | | |name3|value3|

こういうのは再帰で処理するといいと思います。

■呼び出し元

VBA

1 MAXROW = 10 ' グローバル。Excelテーブルの行数 2 MAXCOL = 10 ' グローバル。1行のカラム数の制限値(ここまで解析) 3 Col1 = nnn ' グローバル。ノード名の入っているカラムの位置 4 Col2 = nnn ' グローバル。値の入っているカラムの位置 5 ' ...グローバル多過ぎ 6 Call unit(Root, 1, 1) ' Root: XMLDocumentのルートエレメント

■再帰ルーチン

VBA

1Private Function unit(ByVal parent As String, ByRef rx As Long, ByVal level As Long) As Long 2'============================================================================== 3'■unit : 再帰単位。 4'============================================================================== 5 Dim self As Object 6 Dim cx As Long 7 8 Do 9 Dim name As String: name = Cells(rx, Col1) ' エレメント名 10 Set self = parent.appendChild(parent.createNode(NODE_ELEMENT, x, "")) ' エレメント追加 11 self.Text = Cells(rx, Col2) ' 値 12 ' 13 ' 次の行の有効セルのカラム位置を求める。空行は無視する 14 ' 15 Do 16 rx = rx + 1 ' 次の行 17 If (rx > MAXROW) Then ' Excelテーブルの終端に到達 18 unit = 0 ' 全処理終わり 19 Exit Function 20 End If 21 For cx = 1 To MAXCOL ' 行末までの間で値のあるカラム位置を求める 22 If (Cells(rx, cx) <> "") Then Exit For 23 Next cx 24 While (cx > MAXCOL) ' 空行の間ループ 25 ' 26 ' 有効セル位置を判断 27 ' 28 If (cx > level) Then cx = unit(self, rx, level + 1) ' セルが右にあるなら下位層へダイブ 29 Loop While (level = cx) ' セルが同じ位置ならループ 30 unit = cx ' セルが左にあるなら復帰 31 32End Function 33

これで、MAXCOLのカラム位置(=階層)まで対応できます。

ちなみに、元のExcelテーブルですが、階層を示すのに<>""とするなら、
その位置にname、value入れるようにしたほうが見易いように思えます↓

列1列2列3列4列5
name1value1
name2value2
name3Value3

投稿2018/03/30 08:24

h.horikoshi

総合スコア505

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問