Question

我正在尝试创建一个宏来从XML获取信息并使用MSXML2进行解析。从下面的XML中可以看出，一些子节点具有相同的行号，我试图看看最好的方法是让我通过具有相同行号的子节点并将该信息输出到同一行电子表格的一行。例如，我希望第2行的所有内容都在excel的第13行，然后第3行将在第14行，因为＆＃34; i＆＃34;将增加到1 ..

Sub ModifierItems()
    Set itemchecknode = xmldoc.SelectNodes("/ExportData/LineItemList/LineItem/RowType/text()")
    Set itemnumnode = xmldoc.SelectNodes("/ExportData/LineItemList/LineItem/Product/text()")
    Set itemdescnode = xmldoc.SelectNodes("/ExportData/LineItemList/LineItem/Description/text()")
    Set itemlistnode = xmldoc.SelectNodes("/ExportData/LineItemList/LineItem/cpListPrice/text()")
    Set itemcountnode = xmldoc.SelectNodes("/ExportData/LineItemList/LineItem")
    Set itemreslnode = xmldoc.SelectNodes("/ExportData/LineItemList/LineItem/cpUnitPrice/text()")
    Set itemrownumnode = xmldoc.SelectNodes("/ExportData/LineItemList/LineItem/RowNum/text()")

    For i = 0 To (itemcountnode.Length - 1)
        itemnum = itemnumnode(i).NodeValue
        itemdesc = itemdescnode(i).NodeValue
        itemlist = itemlistnode(i).NodeValue
        itemrownum = itemrownumnode(i).NodeValue
        itembdnum = itembdnumnode(i).NodeValue
        itemresl = itemreslnode(i).NodeValue
        xmlWK.Range("A" & i + 13).Value = itemnum
        xmlWK.Range("B" & i + 13).Value = itemdesc
        xmlWK.Range("C" & i + 13).Value = itemlist
        xmlWK.Range("D" & i + 13).Value = itemresl
    Next    
End Sub

CLICK HERE FOR THE Sample XML

<?xml version="1.0" encoding="UTF-8"?>
<ExportData xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">
  <Header>
    <CustomerNumber>100</CustomerNumber>
    <City>Plain</City>
    <ZipCode>41803</ZipCode>
  </Header>
  <LineItemList>
    <LineItem>
      <Product>719-AF21</Product>
      <RowNum>2</RowNum>
      <RowType>Product</RowType>
      <Qty>1</Qty>
      <Description>H380Gen</Description>
      <cpListPrice>1000</cpListPrice>
      <cpUnitPrice>100</cpUnitPrice>
    </LineItem>
    <LineItem>
      <Product>72</Product>
      <RowNum>2</RowNum>
      <RowType>Discount</RowType>
      <Qty>1</Qty>
      <Description xsi:nil="true"/>
      <cpListPrice>0</cpListPrice>
      <cpUnitPrice>0</cpUnitPrice>
    </LineItem>
    <LineItem>
      <Product>06</Product>
      <RowNum>2</RowNum>
      <RowType>Discount</RowType>
      <Qty>1</Qty>
      <Description xsi:nil="true"/>
      <cpListPrice>0</cpListPrice>
      <cpUnitPrice>0</cpUnitPrice>
    </LineItem>
    <LineItem>
      <Product>A9</Product>
      <RowNum>2</RowNum>
      <RowType>Discount</RowType>
      <Qty>1</Qty>
      <Description xsi:nil="true"/>
      <cpListPrice>0</cpListPrice>
      <cpUnitPrice>0</cpUnitPrice>
    </LineItem>
    <LineItem>
      <Product>7190-zb21</Product>
      <RowNum>3</RowNum>
      <RowType>ProductOption</RowType>
      <Qty>1</Qty>
      <Description>U.S.</Description>
      <cpListPrice>0</cpListPrice>
      <cpUnitPrice>0</cpUnitPrice>
    </LineItem>
    <LineItem>
      <Product>06</Product>
      <RowNum>3</RowNum>   
      <RowType>Discount</RowType> 
      <Qty>1</Qty>    
      <Description xsi:nil="true"/>    
      <cpListPrice>0</cpListPrice>    
      <cpUnitPrice>0</cpUnitPrice>
    </LineItem>
    <LineItem>
      <Product>A9</Product>    
      <RowNum>3</RowNum>    
      <RowType>Discount</RowType>    
      <Qty>1</Qty>    
      <Description xsi:nil="true"/>    
      <cpListPrice>0</cpListPrice>    
      <cpUnitPrice>0</cpUnitPrice>
    </LineItem>
  </LineItemList>
</ExportData>

点击此处查看输出 Expected output

Answer 1

这对我来说测试正常：

Sub Tester()
    Dim xmlDoc As New MSXML2.DOMDocument30
    Dim objNodes As IXMLDOMNodeList, o As Object
    Dim rowtype, itemnum, itemdesc, itemlist, itemresl, rownum
    Dim sht As Worksheet, f As Range, sep

    xmlDoc.async = False

    'xmlDoc.Load "D:\Analysis\config.xml"
    xmlDoc.LoadXML Range("A1").Value
    xmlDoc.setProperty "SelectionLanguage", "XPath"

    If xmlDoc.parseError.errorCode <> 0 Then

        MsgBox "Error!" & vbCrLf & _
        "  Line: " & xmlDoc.parseError.Line & vbCrLf & _
        "  Text:" & xmlDoc.parseError.srcText & vbCrLf & _
        "  Reason: " & xmlDoc.parseError.reason

    Else

        Set objNodes = xmlDoc.SelectNodes("/ExportData/LineItemList/LineItem")
        If objNodes.Length = 0 Then
          Debug.Print "not found"
        Else

            Set sht = ActiveSheet

            For Each o In objNodes

                rownum = GetNodeVal(o, "RowNum/text()")
                rowtype = GetNodeVal(o, "RowType/text()")
                itemnum = GetNodeVal(o, "Product/text()")
                itemdesc = GetNodeVal(o, "Description/text()")
                itemlist = GetNodeVal(o, "cpListPrice/text()")
                itemresl = GetNodeVal(o, "cpUnitPrice/text()")

                If Len(rownum) = 0 Then rownum = 999

                'is this rownum already listed?
                Set f = sht.Range("A13:A10000").Find(rownum, , xlValues, xlWhole)
                If Not f Is Nothing Then
                    sep = vbLf 'already listed: set newline
                Else
                    'not listed: add it
                    Set f = sht.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                    f.Value = rownum
                    sep = "" 'no newline separator needed
                End If

                'add the values....
                With f.EntireRow
                    .Cells(2).Value = .Cells(2).Value & sep & itemdesc
                    .Cells(3).Value = .Cells(3).Value & sep & itemlist
                    .Cells(4).Value = .Cells(4).Value & sep & itemresl
                    .Cells(5).Value = .Cells(5).Value & sep & rowtype
                End With

            Next o

        End If 'have line items

    End If 'parsed OK
End Sub

'get the value of a child node (which may or may not exist)
Function GetNodeVal(o As Object, xPath As String)
    Dim rv, el
    If Not o Is Nothing Then
        Set el = o.SelectSingleNode(xPath)
        If Not el Is Nothing Then rv = el.NodeValue
    End If
    GetNodeVal = rv
End Function

使用VBA循环XML文件

1 个答案: