根据 .csv 文件更新 .xml 文档 数据XSLTVBA输出

问题描述

我是 VBA 的新手，我正在努力寻找解决问题的方法。基本上，我需要做的是根据 .csv 文档的内容编辑 .xml 文件中的一些节点。

特别是，每当我遍历 XML 文档（即“C:\Users\xxx\Desktop\ppp.xml”）并且偶然发现一个特定节点（让它成为 thing）时，我需要读取该节点的文本并在 CSV 文件中查找它（即 C:\Users\xxx\Desktop\mycopy.csv”）。然后编辑不同节点的文本（让它成为 {{1} }) 在同一个 XML 文件中。我在考虑以下基本原理：

1. 由于编辑 XML 文件（以下我使用的是 Microsoft XML，v3.0）需要根据 .csv 内容进行。
2. 我首先将 CSV 转换为 Excel 工作簿 (.xlsx)（我不太了解 CSV 文件的管理，因此这种方式对我来说更易于管理）。
3. 然后在 VBA 中执行某种 qt 版本。

效果很好，如果我单独运行下面显示的这部分代码。由于我知道一些 VBA 中的 XML，因此我对如何编辑节点和属性有了基本的了解。但是，我很难将 XML 文件链接到 Excel 工作簿。我在 VBA 中查看了很多 XML 编辑示例，但是编辑是根据相同的 XML 执行的，而不是在不同的文件中查找值。我将发布我的代码示例，这显然不起作用，希望它足够清楚。谢谢。

Vlookup

我很清楚代码中没有意义的部分如下：

Option Explicit
    
Sub editxml()
    
    Dim Obj As DOMDocument  
    Dim xmlpath As String
    Dim loadcheck As Boolean
    Dim Node As IXMLDOMNodeList  
    Dim Nm As IXMLDOMNode 
    Dim thing As Object,q As Object
    
    Dim wb As Workbook         
    Dim ws As Worksheet
    Dim mycsvfile As String 
    Dim i As Integer,numcol As Integer
    Dim line As String
    Dim row As Integer 
    Dim matrix As Variant  
    
    Dim rngSearch As Range,rngLast As Range,rngFound As Range
    Dim strFirstAddress As String
    
    Set Obj = New DOMDocument
    Obj.async = False: Obj.validateOnParse = False
    
    xmlpath = "C:\Users\xxx\Desktop\ppp.xml"
    Obj.SetProperty "SelectionNamespaces","xmlns:ns0='http://update.DocumentTypes.Schema.ppp.Xml'"
    
    loadcheck = Obj.Load(xmlpath)
    If loadcheck = True Then
        MsgBox "File XML uploaded"
    Else
        MsgBox "File XML not uploaded"
    End If
    
    Set Node = Obj.DocumentElement.SelectNodes("AA/BB/CC/DD")
    
    For Each Nm In Node
        Set thing = Nm.SelectSingleNode("thing")
        Set q = Nm.SelectSingleNode("qt")
        
        If thing.Text = rngFound Then
        q.Text = "do somewhat else"
        End If
    Next
        
    Obj.Save (xmlpath)
    
    Set wb = Workbooks.Add
    wb.SaveAs Filename:="csvtoxlsxfind" & ".xlsx"  
    Set ws = wb.Sheets(1)
    
    With ws
        row = 1
    
        mycsvfile = "C:\Users\xxx\Desktop\mycopy.csv"  
    
        Open mycsvfile For Input As #1
        
        Do Until EOF(1)
            Line Input #1,line    
            matrix = Split(line,",") 
            
            numcol = UBound(matrix) - LBound(matrix) + 1    
       
            For i = 1 To numcol     
                Cells(row,i) = matrix(i - 1)      
            Next i
            row = row + 1
        
        Loop
        Close #1
        
        'set the search range,i.e where I have to find the value:
        Set rngSearch = .Range("AR:AR")
    
        'specify last cell in range:
        Set rngLast = rngSearch.Cells(rngSearch.Cells.Count)
    
        'Find the "thing" in search range,when it first occurrs (rngFound=1st occurrence).
        Set rngFound = rngSearch.find(What:=thing.Text,After:=rngLast,LookIn:=xlValues,LookAt:=xlWhole,SearchOrder:=xlByRows,SearchDirection:=xlNext,MatchCase:=False,SearchFormat:=False)
    
        'if the "thing" is found in search range:
        If Not rngFound Is nothing Then
            'saves the address of the first occurrence of the "thing" in the strFirstAddress variable:
            strFirstAddress = rngFound.Address
        
            Do
            'Find next occurrence of the "thing". 
            
            MsgBox rngFound.Address & " " & rngFound.Offset(0,-29).Value * rngFound.Offset(0,-6)
            
            Set rngFound = rngSearch.FindNext(rngFound)
            rngFound.Font.Color = vbRed
            rngFound.Offset(0,-40).Font.Color = vbRed
            
            Loop Until rngFound.Address = strFirstAddress
            
        Else
            MsgBox "thing not found"
        End If
    End With
    
End Sub 

因为我还没有定义 For Each Nm In Node Set thing = Nm.SelectSingleNode("thing") Set q = Nm.SelectSingleNode("qt") If thing.Text = rngFound Then q.Text = "do somewhat else" End If Next （这将是我的 Vlookup 搜索的结果）。

我遵循的逻辑是否有意义，或者代码需要从头开始重写？是否可以避免 CSV 文件的 Excel .xlsx 转换，从而直接在 CSV 中进行搜索？

更新（回答 Tim Williams 的问题） 在代码的以下部分中，我需要使用 .csv 文件中两个单元格的乘积更新每个节点“事物”的文本，例如

rngFound

是否可以对集合对象中的元素应用诸如偏移函数之类的东西？我知道偏移量只能应用于一个范围，所以我认为需要为此创建一个新函数，对吗？

解决方法

未经测试，但我认为应该是正确的。由于“查找范围内所有匹配的单元格”是一项非常常见的任务，因此我喜欢为此使用独立函数，而不是用该逻辑使主代码混乱。

Sub editxml()
    
    Dim Obj As MSXML2.DOMDocument60
    Dim xmlpath As String
    Dim Node As IXMLDOMNodeList
    Dim Nm As IXMLDOMNode
    Dim thing As Object,q As Object
    Dim wb As Workbook,ws As Worksheet
    Dim matches As Collection
    
    Set Obj = New DOMDocument60
    Obj.async = False
    Obj.validateOnParse = False
    
    xmlpath = "C:\Users\xxx\Desktop\ppp.xml"
    Obj.SetProperty "SelectionNamespaces","xmlns:ns0='http://update.DocumentTypes.Schema.ppp.Xml'"
    
    If Obj.Load(xmlpath) = True Then
        MsgBox "File XML uploaded"
    Else
        MsgBox "File XML not uploaded"
        Exit Sub
    End If
    
    'open the CSV file
    Set wb = Workbooks.Open("C:\Users\xxx\Desktop\mycopy.csv")
    Set ws = wb.Worksheets(1)
    
    Set Node = Obj.DocumentElement.SelectNodes("AA/BB/CC/DD")
    
    For Each Nm In Node
        Set thing = Nm.SelectSingleNode("thing")
        Set q = Nm.SelectSingleNode("qt")
        
        'moved the Find logic to a standalone function
        Set matches = FindAll(ws.Range("AR:AR"),thing.Text)
        
        'did we get any matches in the range?
        If matches.Count > 0 Then
            'It's not clear what should go here - are you replacing
            ' with some other text from the CSV,or just a fixed value?
            q.Text = "do somewhat else"
            
            'you can apply formatting to the found cells here...
        End If
    Next
        
    Obj.Save xmlpath
    
End Sub

'find all matching cells in a range and return them in a Collection
Public Function FindAll(rng As Range,val As String) As Collection
    Dim rv As New Collection,f As Range,addr As String
    Set f = rng.Find(what:=val,after:=rng.Cells(rng.Cells.Count),_
        LookIn:=xlValues,LookAt:=xlWhole,SearchOrder:=xlByRows,_
        SearchDirection:=xlNext,MatchCase:=False)
    If Not f Is Nothing Then addr = f.Address() 'store first cell found
    Do Until f Is Nothing
        rv.Add f
        Set f = rng.FindNext(after:=f)
        If f.Address() = addr Then Exit Do 'exit if we've looped back to first cell
    Loop
    Set FindAll = rv
End Function

,

任何时候您需要编辑 XML，请考虑 XSLT，这是一种专门用于转换 XML 文件的专用编程语言（可以在 VBA 中分层）。专门针对您的情况，您可以遍历 CSV 导入以将值传递到参数化的 XSLT。

为了演示（直到 OP 包含示例数据），下面使用前三个 vba 和 xslt StackOverflow 用户的 XML：>

数据

XML （注意要更新的空 <total_rep> 节点）

<?xml version="1.0"?>
<stackoverflow>
  <group lang="vba">
    <topusers>
      <user>Siddharth Rout</user>
      <link>https://stackoverflow.com/users/1140579/siddharth-rout</link>
      <location>Mumbai,India</location>
      <total_rep></total_rep>
      <tag1>excel</tag1>
      <tag2>vba</tag2>
      <tag3>excel-formula</tag3>
    </topusers>
    <topusers>
      <user>Scott Craner</user>
      <link>https://stackoverflow.com/users/4851590/scott-craner</link>
      <location>Flyover Country</location>
      <total_rep></total_rep>
      <tag1>excel</tag1>
      <tag2>vba</tag2>
      <tag3>excel-formula</tag3>
    </topusers>
    <topusers>
      <user>Tim Williams</user>
      <link>https://stackoverflow.com/users/478884/tim-williams</link>
      <location>San Francisco,CA,United States</location>
      <total_rep></total_rep>
      <tag1>vba</tag1>
      <tag2>excel</tag2>
      <tag3>arrays</tag3>
    </topusers>
  </group>
  <group lang="xslt">
    <topusers>
      <user>Dimitre Novatchev</user>
      <link>https://stackoverflow.com/users/36305/dimitre-novatchev</link>
      <location>United States</location>
      <total_rep></total_rep>
      <tag1>xslt</tag1>
      <tag2>xml</tag2>
      <tag3>xpath</tag3>
    </topusers>
    <topusers>
      <user>Martin Honnen</user>
      <link>https://stackoverflow.com/users/252228/martin-honnen</link>
      <location>Germany</location>
      <total_rep></total_rep>
      <tag1>xslt</tag1>
      <tag2>xml</tag2>
      <tag3>xpath</tag3>
    </topusers>
    <topusers>
      <user>Michael Kay</user>
      <link>https://stackoverflow.com/users/415448/michael-kay</link>
      <location>Reading,United Kingdom</location>
      <total_rep></total_rep>
      <tag1>xml</tag1>
      <tag2>xslt</tag2>
      <tag3>xpath</tag3>
    </topusers>
  </group>
</stackoverflow>

CSV

用户	total_rep
悉达多溃败	134,062
斯科特·克雷纳	123,313
蒂姆·威廉姆斯	116,760
迪米特雷·诺瓦切夫	227,632
马丁·霍南	134,713
迈克尔·凯	135,177

---

XSLT

（下面另存为 .xsl 文件，一个特殊的 .xml 文件，要在 VBA 中加载）

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

  <!-- INITIALIZE PARAMS -->
  <xsl:param name="user_param"/>
  <xsl:param name="total_rep_param"/>
  
  <!-- IDENTITY TRANSFORM -->
  <xsl:template match="@*|node()">
    <xsl:copy>
      <xsl:apply-templates select="@*|node()"/>
    </xsl:copy>
  </xsl:template>
  
  <!-- CONDITIONALLY UPDATE TEXT BY DIFFERENT NODE MATCH -->
  <xsl:template match="topusers">
    <xsl:copy>
        <xsl:apply-templates select="user|link|location"/>
        <total_rep>
            <xsl:choose>
                <xsl:when test="user = $user_param">
                    <xsl:value-of select="$total_rep_param"/>
                </xsl:when>
                <xsl:otherwise>
                    <xsl:value-of select="total_rep"/>
                </xsl:otherwise>
            </xsl:choose>
        </total_rep>
        <xsl:apply-templates select="tag1|tag2|tag3"/>
    </xsl:copy>
  </xsl:template>
  
</xsl:stylesheet>

VBA

（加载 CSV 和转换 XML 的两个子程序，XSLT 中要匹配的参数名称）

Sub LoadCSV()
    Dim csv_file As String
    
    csv_file = "C:\Path\To\File.csv"
    
    With ThisWorkbook.Worksheets("Sheet1")
        .Columns("A:D").EntireColumn.Delete
        
        With .QueryTables.Add(Connection:="TEXT;" & csv_file,_
                          Destination:=.Range("A1"))
               .TextFileParseType = xlDelimited
               .TextFileCommaDelimiter = True
               .Refresh
        End With
    
       .QueryTables(1).SaveData = False
       .QueryTables.Item(1).Delete
    End With
End Sub

Sub TransformXML()
    ' REFERENCE Microsoct XML,v6.0
    Dim xmlDoc As MSXML2.DOMDocument60
    Dim xslDoc As MSXML2.FreeThreadedDOMDocument60
    Dim xslTemp As MSXML2.XSLTemplate60
    Dim xslProc As Object
    
    Dim i As Long,lastrow As Long
    Dim param1 As Variant,param2 As Variant

    Call LoadCSV                                        ' LOAD CSV FILE
    
    Set xmlDoc = New MSXML2.DOMDocument60               ' LOAD XML FILE
    xmlDoc.Load "C:\Path\To\Input.xml"

    Set xslDoc = New MSXML2.DOMDocument60               ' LOAD XSL SCRIPT
    xslDoc.Load "C:\Path\To\Script.xsl"
    
    ' INITIALIZE NEEDED OBJECTS
    Set xslTemp = New MSXML2.XSLTemplate60
    Set xslTemp.stylesheet = xslDoc
    Set xslProc = xslTemp.createProcessor()
    
    With ThisWorkbook.Worksheets("Sheet1")
        lastrow = .Cells(.Rows.Count,"A").End(xlUp).Row

        ' ITERATE THROUGH CSV DATA
        For i = 2 To lastrow
            param1 = .Range("A" & i).Value
            param2 = .Range("B" & i).Value
            
            With xslProc
               .input = xmlDoc
               .addParameter "user_param",param1      ' ADD PARAMETER(S)
               .addParameter "total_rep_param",param2

               .transform                              ' TRANSFORM XML
                xmlDoc.LoadXML .output                 ' LOAD RESULT TREE
            End With
        Next i
    End With

    xmlDoc.Save "C:\Path\To\Output.xml"                ' SAVE OUTPUT TO FILE
       
    Set xmlDoc = Nothing: Set xslDoc = Nothing
    Set xslTemp = Nothing: Set xslProc = Nothing
End Sub

---

输出

（注意 <total_rep> 从 CSV 填充）

<?xml version="1.0"?>
<stackoverflow>
    <group lang="vba">
        <topusers>
            <user>Siddharth Rout</user>
            <link>https://stackoverflow.com/users/1140579/siddharth-rout</link>
            <location>Mumbai,India</location>
            <total_rep>134062</total_rep>
            <tag1>excel</tag1>
            <tag2>vba</tag2>
            <tag3>excel-formula</tag3>
        </topusers>
        <topusers>
            <user>Scott Craner</user>
            <link>https://stackoverflow.com/users/4851590/scott-craner</link>
            <location>Flyover Country</location>
            <total_rep>123313</total_rep>
            <tag1>excel</tag1>
            <tag2>vba</tag2>
            <tag3>excel-formula</tag3>
        </topusers>
        <topusers>
            <user>Tim Williams</user>
            <link>https://stackoverflow.com/users/478884/tim-williams</link>
            <location>San Francisco,United States</location>
            <total_rep>116760</total_rep>
            <tag1>vba</tag1>
            <tag2>excel</tag2>
            <tag3>arrays</tag3>
        </topusers>
    </group>
    <group lang="xslt">
        <topusers>
            <user>Dimitre Novatchev</user>
            <link>https://stackoverflow.com/users/36305/dimitre-novatchev</link>
            <location>United States</location>
            <total_rep>227632</total_rep>
            <tag1>xslt</tag1>
            <tag2>xml</tag2>
            <tag3>xpath</tag3>
        </topusers>
        <topusers>
            <user>Martin Honnen</user>
            <link>https://stackoverflow.com/users/252228/martin-honnen</link>
            <location>Germany</location>
            <total_rep>134713</total_rep>
            <tag1>xslt</tag1>
            <tag2>xml</tag2>
            <tag3>xpath</tag3>
        </topusers>
        <topusers>
            <user>Michael Kay</user>
            <link>https://stackoverflow.com/users/415448/michael-kay</link>
            <location>Reading,United Kingdom</location>
            <total_rep>135177</total_rep>
            <tag1>xml</tag1>
            <tag2>xslt</tag2>
            <tag3>xpath</tag3>
        </topusers>
    </group>
</stackoverflow>