在多个ID的特定行位置插入唯一ID [英] Inserting a Unique ID in Specific Row Locations for Multiple IDs

问题描述

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

1）Excel在XML报表中搜索ENTITY标题标签，并存储包含在左标签的末尾（即>）和右侧标签的开头（即<）。

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

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

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

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

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

编辑：

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

 < Results xmlns：xsi =http：// www .w3.org / 2001 / XMLSchema-instancexmlns：xsd =http://www.w3.org/2001/XMLSchema> 
<参考> {REFERENCE-HERE}< / Reference> 
< FillerTags>填充< / 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> 
  

，将被修改为如下所示：

 <结果xmlns：xsi =http://www.w3.org/2001/XMLSchema-instancexmlns：xsd =http://www.w3.org / 2001 / XMLSchema的> 
<参考> {REFERENCE-HERE}< / Reference> 
< FillerTags>填充< / 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）），<实体>）
 
与ActiveSheet 
对于i = 1到LastEntity 
 Cells.Find（什么：=ENTITY（i），之后：= ActiveCell，LookIn：= xlFormulas，_ 
 MatchCase：= False，SearchFormat：= False）。激活
对于j = 1到LastItem 
  

我被卡住的第一个地方如下：我如何告诉VBA循环使用查找功能时出现的所有值。例如，如果出现50次如何告诉VBA从第一个实体开始，那么开始对于j = 1到LastItem 循环？在上面的设置是否接近正确？

解决方案

使用记事本/ etc将您的XML复制到纯文本文件。然后保存为XML文件，确保文件类型为所有文件

然后关闭该XML文件。

以下示例说明如何根据您的问题解析和修改XML。我不会告诉你如何使用Excel工作表，这是一个客观错误的操作XML数据的方法。

此代码成功修改了您的初始状态到描述的示例输出。

  Option Explicit 
公共声明Sub Sleep Libkernel32（ByVal dwMilliseconds As Long）
 Sub ParseResults（）
'需要引用Microsoft XML，v6.0 
'需要引用到Microsoft Scripting Runtime 
 Dim xmlFilePath $，newFilePath $ 
 Dim DOM作为MSXML2.DOMDocument 
 Dim实体作为IXMLDOMNode 
 Dim fso As Scripting.FileSystemObject 
 
'＃定义要作为XML加载的文件
 xmlFilePath = C：\users\david_zemens\desktop\results.xml
 
'＃定义一个输出路径，将修改后的XML 
 newFilePath =C：\users \david_zemens\desktop\updated_results.xml
 
'＃创建我们的DOM对象
设置DOM = CreateObject（MSXML2.DOMDocument）
 
'＃加载XML文件
 DOM.Load xmlFilePath 
 
'＃等到文档加载
 Do 
睡眠250 
循环直到DOM.ReadyState = 4 
 
'＃获取entityID节点
设置entity = DOM.DocumentElement.getElementsByTagName（entityId） （0）
 
'＃调用子程序将实体附加到项目标签
 AppendEntity DOM，Item，entity 
'＃调用一个子例程来附加实体到AnotherItem标签
 AppendEntity DOMAnotherItem，实体
 
'##创建一个FSO写入新文件
设置fso = CreateObject（Scripting.FileSystemObject ）
 
'##尝试将新的/修改后的XML写入文件
 On Error Resume Next 
 fso.CreateTextFile（newFilePath，True，True）.Write DOM.XML 
如果Err然后
'##在立即窗口中打印新的XML 
 Debug.Print DOM.XML 
 MsgBox无法写入& newFilePath& 请在VBE的立即窗口中查看XML。，vbInformation 
 Err.Clear 
如果
出现错误GoTo 0 
 
'清理
设置DOM = Nothing 
设置fso = Nothing 
设置entity = Nothing 
 
 End Sub 
 
 Sub AppendEntity（DOM As Object，tagName As String，copyNode As对象）
'##此子例程将附加子节点到匹配特定字符串标签的所有XML节点。 
 Dim itemColl As IXMLDOMNodeList 
 Dim itm As IXMLDOMNode 
 
'＃获取与tagName匹配的所有元素的集合
设置itemColl = DOM.DocumentElement.getElementsByTagName（tagName） 
 
'＃迭代集合，附加复制的节点
对于每个itm在itemColl 
如果itm.HasChildNodes然后
'＃在第一个孩子之前插入此节点节点
 itm.InsertBefore copyNode.CloneNode（True），itm.FirstChild 
 Else 
'＃将该节点附加到项目
 itm.appendChild copyNode.CloneNode（True） 
结束如果
下一个
 
设置itm =没有
设置itemColl =没有
 
结束Sub 
  

更新

添加了一个忙/ （希望）确保DOM已经完全加载了XML。在一个比简单的例子更大的文件上，这可能需要几秒钟的时间才能加载，如果您尝试在准备好之前解析XML，那么可能会导致错误。

I have a number of identical XML reports stored in excel. In these reports, each item in one of the tables in each report a unique ID relating that item to a specific entity. Each entity has multiple items associated with it. Essentially, the structure of the macro I am looking for is as follows:

1) Excel searches for the ENTITY title tag in the XML report and stores the value contained between the end of the left tag (i.e. >) and the beginning of the right tag (i.e. <).

2) Excel searches for the ITEM title tag (the match must be exact).

3) Excel selects the row below the ITEM title tag and moves it down, and inserts the stored ENTITY value to the now empty cell above.

4) Excel continues to do this for all instances of the ITEM tag until it reaches another ENTITY title tag, at which point it loops.

I am thinking I would just need two loops, the ENTITY loop taking priority over the ITEM loop so that it is constantly looking for a new ENTITY. Otherwise I have no idea how it will know to start looking for a new entity.

Any help would be appreciated, thanks!

EDIT:

For reference the XML looks like this:

<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>

and would be modified to look like this:

<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>
    .
    .
    .

I have tried to start by defining some variables and trying to set up a basic structure:

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

The first place I am stuck then is as follows: How do I tell VBA to cycle through all the values that come up when using the 'Find' function. For example, if appears 50 times how do I tell VBA to start with the first entity, then begin the For j = 1 To LastItem loop? Is the setup above anywhere close to correct?

解决方案

Copy your XML in to a plain text file using Notepad/etc. Then save as an XML file making sure that file type is "All files ."

Then close that XML file.

The following example illustrates how to parse and modify the XML per your question. I am not going to show you how to do this using Excel worksheets, that is frankly an objectively wrong way of manipulating XML data.

This code successfully modifies the XML from your initial state to the described example output.

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

UPDATE

Added a busy/waiting loop to (hopefully) ensure that DOM has fully loaded the XML. On a larger file than the simple example, this may take a few seconds to load, and that could raise errors if you attempt to parse the XML before it's ready.

这篇关于在多个ID的特定行位置插入唯一ID的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！