Question

我在excel中存储了许多相同的XML报告。在这些报告中，每个报告中的一个表中的每个项目都报告了将该项目与特定实体相关联的唯一ID。每个实体都有多个与之关联的项目。基本上，我正在寻找的宏的结构如下：

1）Excel在XML报告中搜索ENTITY标题标签，并存储左标签末尾（即＆gt;）和右标签开头（即＆lt;）之间的值。

2）Excel搜索ITEM标题标签（匹配必须准确）。

3）Excel选择ITEM标题标签下方的行并向下移动，并将存储的ENTITY值插入上面现在为空的单元格。

4）Excel继续为ITEM标记的所有实例执行此操作，直到它到达另一个ENTITY标题标记，此时它将循环。

我想我只需要两个循环，ENTITY循环优先于ITEM循环，因此它不断寻找新的ENTITY。否则我不知道如何开始寻找新的实体。

任何帮助将不胜感激，谢谢！

编辑：

作为参考，XML看起来像这样：

<Results xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
  <Reference>{REFERENCE-HERE}</Reference>
  <FillerTags>Filler</FillerTags>
  <entity>
    <entityName>ABC</entityName>
    <entityId>012345</entityId>
  </entity>
  <Items>
    <Item>
      <FillerTagsAgain>Filler2</FillerTagsAgain>
      <FillerTagsAgain>Filler2</FillerTagsAgain>
      <FillerTagsAgain>Filler2</FillerTagsAgain> 
     </Item>
     <AnotherItem> 
       <FillerTagsAgain>Filler2</FillerTagsAgain>
       <FillerTagsAgain>Filler2</FillerTagsAgain>
       <FillerTagsAgain>Filler2</FillerTagsAgain> 
     </AnotherItem>
   </Items>

并将修改为如下所示：

<Results xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema">
  <Reference>{REFERENCE-HERE}</Reference>
  <FillerTags>Filler</FillerTags>
  <entity>
    <entityName>ABC</entityName>
    <entityId>012345</entityId>
  </entity>
  <Items>
    <Item>
      <entityId>012345</entityId>
      <FillerTagsAgain>Filler2</FillerTagsAgain>
      <FillerTagsAgain>Filler2</FillerTagsAgain>
      <FillerTagsAgain>Filler2</FillerTagsAgain> 
     </Item>
     <AnotherItem> 
       <entityId>012345</entityId>
       <FillerTagsAgain>Filler2</FillerTagsAgain>
       <FillerTagsAgain>Filler2</FillerTagsAgain>
       <FillerTagsAgain>Filler2</FillerTagsAgain> 
     </AnotherItem>
   </Items>
 <entity>
    .
    .
    .

我试图从定义一些变量开始尝试建立一个基本结构：

Dim entity As String
Dim item As String
Dim i As Long
Dim j As Long
Dim wb As Workbook
Dim LastEntity As Long
Dim LastItem As Long

LastEntity = Cells.CountIf(Range("A1:A438486")), "<Entity>")

With ActiveSheet
    For i = 1 To LastEntity
    Cells.Find(What:="ENTITY(i)", After:=ActiveCell, LookIn:=xlFormulas, _
               MatchCase:=False, SearchFormat:=False).Activate
        For j = 1 To LastItem

我被困的第一个地方如下：我如何告诉VBA循环使用＆＃39;查找＆＃39;时出现的所有值。功能。例如，如果出现50次，我如何告诉VBA从第一个实体开始，然后开始For j = 1 To LastItem循环？上面的设置是否接近正确？

Answer 1

使用记事本/等将XML复制到纯文本文件中。然后保存为XML文件，确保文件类型为＆＃34;所有文件。＆＃34;

enter image description here

然后关闭该XML文件。

以下示例说明了如何根据您的问题解析和修改XML。我不打算使用Excel工作表向您展示如何执行此操作，坦率地说，这是一种操纵XML数据的客观错误方法。

此代码成功地将XML从初始状态修改为所描述的示例输出。

Option Explicit
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub ParseResults()
'Requires reference to Microsoft XML, v6.0
'Requires referenc to Microsoft Scripting Runtime
Dim xmlFilePath$, newFilePath$
Dim DOM As MSXML2.DOMDocument
Dim entity As IXMLDOMNode
Dim fso As Scripting.FileSystemObject

'# Define the file you are going to load as XML
xmlFilePath = "C:\users\david_zemens\desktop\results.xml"

'# Define an output path for where to put the modified XML
newFilePath = "C:\users\david_zemens\desktop\updated_results.xml"

'# Create our DOM object
Set DOM = CreateObject("MSXML2.DOMDocument")

'# Load the XML file
DOM.Load xmlFilePath

'# Wait until the Document has loaded
Do
    Sleep 250
Loop Until DOM.ReadyState = 4

'# Get the entityID node
Set entity = DOM.DocumentElement.getElementsByTagName("entityId")(0)

'# Call a subroutine to append the entity to "Item" tags
AppendEntity DOM, "Item", entity
'# Call a subroutine to append the entity to "AnotherItem" tags
AppendEntity DOM, "AnotherItem", entity

'## Create an FSO to write the new file
Set fso = CreateObject("Scripting.FileSystemObject")

'## Attempt to write the new/modified XML to file
On Error Resume Next
fso.CreateTextFile(newFilePath, True, True).Write DOM.XML
If Err Then
    '## Print the new XML in the Immediate window
    Debug.Print DOM.XML
    MsgBox "Unable to write to " & newFilePath & " please review XML in the Immediate window in VBE.", vbInformation
    Err.Clear
End If
On Error GoTo 0

'Cleanup
Set DOM = Nothing
Set fso = Nothing
Set entity = Nothing

End Sub

Sub AppendEntity(DOM As Object, tagName As String, copyNode As Object)
'## This subroutine will append child node to ALL XML Nodes matching specific string tag.
Dim itemColl As IXMLDOMNodeList
Dim itm As IXMLDOMNode

'# Get a collection of all elements matching the tagName
Set itemColl = DOM.DocumentElement.getElementsByTagName(tagName)

'# Iterate over the collection, appending the copied node
For Each itm In itemColl
    If itm.HasChildNodes Then
        '# Insert this node before the first child node of Item
        itm.InsertBefore copyNode.CloneNode(True), itm.FirstChild
    Else
        '# Append this node to the Item
        itm.appendChild copyNode.CloneNode(True)
    End If
Next

Set itm = Nothing
Set itemColl = Nothing

End Sub

<强>更新

添加了忙/等待循环（希望）确保DOM已完全加载XML。在比简单示例更大的文件上，这可能需要几秒钟才能加载，如果您尝试在XML准备好之前解析XML，可能会引发错误。

在多个ID的特定行位置中插入唯一ID

1 个答案: