excelからxmlへのセル値の抽出

Question

私の要件は、ExcelからXMLに行をエクスポートすることです。スプレッドシートは次のようになりますたとえば、：そして、

MessageID OriginalField OriginalCOBO RevisedCOBOL  ChangeIndicator 
I23456I SDQ    SOURCE  SOURCE-DATA-QUEUE 1 

を、私は[Change Indicator]=1に基づいてXMLを作成する必要があります。

列の値は、列ヘッダーではなく要素タグである必要があります。例えば、所望の出力は次のようになります。

<I23456I> 
<SDQ> 
    <COBOLName>SOURCE-DATA-QUEUE</COBOLName> 
</SDQ> 
</I23456I> 

MessageIDとOriginalField値が変化し続けるだろうと、それはすべてのために同じではありません。

ありがとうございました。

Answer 1

VBAオブジェクトのMSXMLを使用して、XMLノードとタグを繰り返し作成することを検討してください（5列目の条件付き：）。最後に、きれいに印刷されたXSLTスタイルシートを使用して、出力されたXMLを適切に改行してインデントします。注意してください：Rootタグは、整形式のXMLファイルのために追加されます。

Sub xmlExport() 
    ' Add Microsoft XML v6.0 VBA Reference ' 
    Dim doc As New MSXML2.DOMDocument60, xslDoc As New MSXML2.DOMDocument60 
    Dim newDoc As New MSXML2.DOMDocument60 
    Dim root As IXMLDOMElement, msgNode As IXMLDOMElement 
    Dim orgfldNode As IXMLDOMElement, orgcoboNode As IXMLDOMElement 
    Dim i As Long 

    ' DECLARE XML DOC OBJECT ' 
    Set root = doc.createElement("Root") 
    doc.appendChild root 

    ' WRITE TO XML ' 
    For i = 2 To Sheets(1).UsedRange.Rows.Count 

     If Cells(i, 5) = 1 Then 

      ' MESSAGE NODE ' 
      Set msgNode = doc.createElement(Cells(i, 1)) 
      root.appendChild msgNode 

      ' ORIGINAL FIELD NODE ' 
      Set orgfldNode = doc.createElement(Cells(i, 2)) 
      msgNode.appendChild orgfldNode 

      ' ORIGINAL COBO NODE ' 
      Set orgcoboNode = doc.createElement("COBOLNAME") 
      orgcoboNode.Text = Cells(i, 4) 
      orgfldNode.appendChild orgcoboNode 
     End If 

    Next i 

    ' PRETTY PRINT RAW OUTPUT ' 
    xslDoc.LoadXML "<?xml version=" & Chr(34) & "1.0" & Chr(34) & "?>" _ 
     & "<xsl:stylesheet version=" & Chr(34) & "1.0" & Chr(34) _ 
     & "   xmlns:xsl=" & Chr(34) & "http://www.w3.org/1999/XSL/Transform" & Chr(34) & ">" _ 
     & "<xsl:strip-space elements=" & Chr(34) & "*" & Chr(34) & " />" _ 
     & "<xsl:output method=" & Chr(34) & "xml" & Chr(34) & " indent=" & Chr(34) & "yes" & Chr(34) & "" _ 
     & "   encoding=" & Chr(34) & "UTF-8" & Chr(34) & "/>" _ 
     & " <xsl:template match=" & Chr(34) & "node() | @*" & Chr(34) & ">" _ 
     & " <xsl:copy>" _ 
     & " <xsl:apply-templates select=" & Chr(34) & "node() | @*" & Chr(34) & " />" _ 
     & " </xsl:copy>" _ 
     & " </xsl:template>" _ 
     & "</xsl:stylesheet>" 

    xslDoc.async = False 
    doc.transformNodeToObject xslDoc, newDoc 
    newDoc.Save ActiveWorkbook.Path & "\Output.xml" 

End Sub 

出力

<?xml version="1.0" encoding="UTF-8"?> 
<Root> 
    <I23456I> 
     <SDQ> 
      <COBOLNAME>SOURCE-DATA-QUEUE</COBOLNAME> 
     </SDQ> 
    </I23456I> 
</Root>