从XML自动填充动态生成的工作表

时间:2019-03-18 17:05:39

标签: excel vba

所以我有一个看起来像这样的XML文件:

<?xml version="1.0"?>
<catalog>
   <query id="bk101">
      <question>Do we have cloud security</question>
      <answer>Yes</answer>
      <genre>Cloud</genre>
   </query>
   <query id="bk102">
      <question>Do we have locks on the door</question>
      <answer>No, we have fingerprint access.</answer>
      <genre>Physical Security</genre>
   </query>
   <query id="bk103">
      <question>What SDLC Priciple is follwed?</question>
      <answer>None</answer>
      <comment>We have code ninjas!</comment>
      <genre>SDLC</genre>
   </query>
</catalog>

genre标记将是工作表名称。然后,我的想法是用给定类型的问题填充(附加)使用类型名称生成的工作表。我用于相同的代码如下:

Function fnReadData()
    Dim eWorkbook As Workbook
    Set eWorkbook = ActiveWorkbook
    Set oXMLFile = CreateObject("Microsoft.XMLDOM")
    xmlUrl = ThisWorkbook.Path & "\dummy.xml"
    oXMLFile.Load (xmlUrl)

    'Read Genres To Populate Worksheet Names
    Set GenreNodes = oXMLFile.SelectNodes("/catalog/query/genre/text()")

    'Create Worksheet Names
    For i = 0 To (GenreNodes.Length - 1)
        Genre = GenreNodes(i).NodeValue
        CreateSheet (Genre)
    Next

    'Populate Worksheet With Questions
    Set Queries = oXMLFile.SelectNodes("/catalog/query")

    'Initialize Row Counter
    rowCounter = 1

    For i = 0 To Queries.Length - 1
        For j = 0 To Queries(i).ChildNodes.Length - 1
            If Queries(i).ChildNodes(j).tagname = "genre" Then
                sheetName = Queries(i).ChildNodes(j).Text
            ElseIf Queries(i).ChildNodes(j).tagname = "question" Then
                Question = Queries(i).ChildNodes(j).Text
            ElseIf Queries(i).ChildNodes(j) = "answer" Then
                Answer = Queries(i).ChildNodes(j).Text
            ElseIf Queries(i).ChildNodes(j).tagname = "comment" Then
                Comment = Queries(i).ChildNodes(j).Text
            End If

            eWorkbook.Sheets(sheetName).Range("A" & rowCounter).Value = Question
            eWorkbook.Sheets(sheetName).Range("B" & rowCounter).Value = Answer
            eWorkbook.Sheets(sheetName).Range("C" & rowCounter).Value = Comment
        Next
            rowCounter = rowCounter + 1
    Next

End Function


Private Sub CreateSheet(sheetName)
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = sheetName
End Sub

我在rowCounter逻辑上度过了艰难的时光,因此,我不断遇到index out of bounds错误。我该如何解决?

谢谢。

1 个答案:

答案 0 :(得分:1)

类似的东西(经过测试):

Dim questions As MSXML2.IXMLDOMNodeList, question As MSXML2.IXMLDOMNode
Dim genre

Set questions = oXMLFile.SelectNodes("/catalog/query")

For Each question In questions
    genre = ChildValue(question, "genre")
    If Len(genre) > 0 Then
        With eWorkbook.Sheets(genre).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow
            .Cells(1).Value = ChildValue(question, "question")
            .Cells(2).Value = ChildValue(question, "answer")
            .Cells(3).Value = ChildValue(question, "comment")
        End With
    End If
Next question

用于获取子节点值的实用函数:

Function ChildValue(n As MSXML2.IXMLDOMNode, childName As String)
    Dim el, rv
    Set el = n.SelectSingleNode(childName)
    If Not el Is Nothing Then rv = el.nodeTypedValue
    ChildValue = rv
End Function