Question

我正在尝试编写一个读取XML文件的Excel宏。该XML文件由一系列字段列表组成，每个字段都包含在<master> </master>中。这些<master>标签数量随机。每组主标记都包含两个其他字段：<proto></proto>和<status></status>，以及与此宏无关的许多其他字段。

{p}和<proto>字段都可以具有三个不同条目之一。在<status>中说I，II和III，在<proto>中说红色，黄色和绿色。因此，文件的格式可能如下：

<status>

其中有数十个或数百个，只是具有不同的值。

我想做的是在这里计算每种可能性的组合数，然后将每种可能性分配给一个变量。

例如，变量<master> <proto> III </proto> <status> red </status> </master>将具有proto1red字段同时包含<master>和<proto>I</proto>的总次数，而变量<status>red</status>将具有proto2red字段包含<master>和<proto>II</proto>的总次数。

这是我开始的地方，基本上只是试图适应我编写的不同脚本，该脚本计算csv文件中的各个项目。

<status>red</status>

（。cr只是用于xml文件的扩展名，供我们使用的自定义应用程序使用）。在这部分之后，只是变量变暗，其他文件类型的相关行也被计数。我不确定如何使用VBA如前所述对字段进行计数，然后将该数字分配给变量。

Answer 1

考虑XSLT，这是一种专用语言，旨在转换XML文件。具体来说，请使用Muenchian Method，它根据 PROTO 和 STATUS 之类的特定值使用关键字为文档编制索引，并可用于计算不同的分组（即，所有分组组合）。 VBA可以通过MSXML库使用XSLT，甚至可以将扁平化的输出作为表格结构导入工作簿：

XSLT （另存为.xsl文件以在VBA中提供）

<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
    <xsl:output indent="yes"/>
    <xsl:strip-space elements="*"/>

    <xsl:key name="combn_key" match="MASTER" use="concat(descendant::PROTO, descendant::STATUS)" />

    <xsl:template match="/SILVERS">
        <root>
          <xsl:apply-templates select="ISILVER/MASTER[generate-id() = 
                                       generate-id(key('combn_key', concat(descendant::PROTO, descendant::STATUS))[1])]"/>
        </root>
    </xsl:template>

    <xsl:template match="MASTER">
        <data>
            <xsl:variable name="pair" select="concat('proto', descendant::PROTO, descendant::STATUS)"/>
            <pair><xsl:value-of select="$pair"/></pair>
            <count><xsl:value-of select="count(. | key('combn_key', concat(descendant::PROTO, descendant::STATUS)))"/></count>
        </data>
    </xsl:template>

</xsl:stylesheet>

VBA

' SET REFERENCE TO Micrsoft XML, v#.#
Dim xmldoc As New MSXML2.DOMDocument, xslDoc As New MSXML2.DOMDocument, newDoc As New MSXML2.DOMDocument

' LOAD XML AND XSL FILES
xmldoc.async = False
xmldoc.Load "C:\Path\To\Input.xml"

xslDoc.async = False
xslDoc.Load "C:\Path\To\XSL\Script.xsl"

' TRANSFORM XML
xmldoc.transformNodeToObject xslDoc, newDoc
newDoc.Save "C:\Path\To\Output.xml"

' IMPORT RESULT XML
Application.Workbooks.OpenXML "C:\Path\To\Output.xml", , xlXmlLoadImportToList

XML 输出

<?xml version="1.0" encoding="utf-8"?>
<root>
  <data>
    <pair>protoIIIRed</pair>
    <count>1</count>
  </data>
  <data>
    <pair>protoIRed</pair>
    <count>1</count>
  </data>
</root>

Excel （导入（相同的配对将使计数增加1以上））

Answer 2

像这样？您实际上并不需要定界符“，”。这只是为了便于阅读。我假设状态/协议不在单个Master中重复吗？如果他们这样做，那么getElementsByTagName部分需要循环整个集合，而不仅仅是使用索引0。

使用您的变量名：

Option Explicit

Public Sub testing()
    Dim xmlDoc As New MSXML2.DOMDocument60
    Set xmlDoc = New MSXML2.DOMDocument60
    xmlDoc.Load "C:\Users\User\Desktop\Test2.xml"
    Dim dict As Object, key As Variant
    Set dict = CreateObject("Scripting.Dictionary")
    Dim Node As IXMLDOMElement
    For Each Node In xmlDoc.SelectNodes("//MASTER")
        On Error Resume Next
        Dim jkey As String
        jkey = Node.getElementsByTagName("PROTO")(0).Text & "," & Node.getElementsByTagName("STATUS")(0).Text
        If Not dict.exists(jkey) Then
            dict.Add jkey, 1
        Else
            dict(jkey) = dict(jkey) + 1
        End If
        On Error GoTo 0
    Next Node

    Dim Proto1Red As Long, Proto2Red As Long, Proto3Red As Long
    Dim Proto1Green As Long, Proto2Green As Long, Proto3Green As Long
    Dim Proto1Yellow As Long, Proto2Yellow As Long, Proto3Yellow As Long
    Dim ikey As Variant
    For Each ikey In dict.keys
       ' Debug.Print iKey, dict(key)
        Select Case ikey
        Case "I,Red"
            Proto1Red = dict(ikey)
        Case "II,Red"
            Proto2Red = dict(ikey)
        Case "III,Red"
            Proto3Red = dict(ikey)
        Case "I,Green"
            Proto1Green = dict(ikey)
        Case "II,Green"
            Proto2Green = dict(ikey)
        Case "III,Green"
            Proto3Green = dict(ikey)
        Case "I,Yellow"
            Proto1Yellow = dict(ikey)
        Case "II,Yellow"
            Proto2Yellow = dict(ikey)
        Case "III,Yellow"
            Proto3Yellow = dict(ikey)
        End Select
    Next

    Dim arr(), i As Long
    arr = Array(Proto1Red, Proto2Red, Proto3Red, Proto1Green, Proto2Green, Proto3Green, Proto1Yellow, Proto2Yellow, Proto3Yellow)

    For i = LBound(arr) To UBound(arr)
        Debug.Print arr(i)
    Next i
End Sub

与Proto串联：

Option Explicit
Public Sub testing()
    Dim xmlDoc As New MSXML2.DOMDocument60
    Set xmlDoc = New MSXML2.DOMDocument60
    xmlDoc.Load "C:\Users\User\Desktop\Test2.xml"
    Dim dict As Object, key As Variant
    Set dict = CreateObject("Scripting.Dictionary")
    Dim Node As IXMLDOMElement
    For Each Node In xmlDoc.SelectNodes("//MASTER")
        On Error Resume Next
        Dim jkey As String
        jkey = "Proto" & Node.getElementsByTagName("PROTO")(0).Text & Node.getElementsByTagName("STATUS")(0).Text
        If Not dict.Exists(jkey) Then
            dict.Add jkey, 1
        Else
            dict(jkey) = dict(jkey) + 1
        End If
        On Error GoTo 0
    Next Node

    Dim Proto1Red As Long, Proto2Red As Long, Proto3Red As Long
    Dim Proto1Green As Long, Proto2Green As Long, Proto3Green As Long
    Dim Proto1Yellow As Long, Proto2Yellow As Long, Proto3Yellow As Long
    Dim ikey As Variant
    For Each ikey In dict.keys
       ' Debug.Print iKey, dict(key)
        Select Case ikey
        Case "I,Red"
            Proto1Red = dict(ikey)
        Case "II,Red"
            Proto2Red = dict(ikey)
        Case "III,Red"
            Proto3Red = dict(ikey)
        Case "I,Green"
            Proto1Green = dict(ikey)
        Case "II,Green"
            Proto2Green = dict(ikey)
        Case "III,Green"
            Proto3Green = dict(ikey)
        Case "I,Yellow"
            Proto1Yellow = dict(ikey)
        Case "II,Yellow"
            Proto2Yellow = dict(ikey)
        Case "III,Yellow"
            Proto3Yellow = dict(ikey)
        End Select
    Next

    Dim arr(), i As Long
    arr = Array(Proto1Red, Proto2Red, Proto3Red, Proto1Green, Proto2Green, Proto3Green, Proto1Yellow, Proto2Yellow, Proto3Yellow)

    For Each key In dict.keys
        Debug.Print key, dict(key)
    Next key
End Sub

输出：

Answer 3

我有类似的任务，我使用Windows商店中的应用程序将xml转换为excel，然后将数据透视表和图表添加到excel文件中。

在VBA宏中统计和关联XML数据

3 个答案: