如何在单个Excel单元格中解析具有相同名称和列表的XML节点值

时间:2019-06-25 20:58:38

标签: excel xml vbscript

我在获取要在Excel中显示的XML子节点值列表时遇到问题。我正在尝试使用名称相同但值不同的多个节点显示在自己的Excel单元格中。

在下面的代码中,我只需要逻辑上如何为每个“规则”在一个单元格中获取这些多个项目的逻辑。我猜我可能需要一个数组,但不确定如何做。

这是我要遍历的XML代码:

<?xml version="1.0" encoding="utf-8"?>
<Benchmark>
    <Group id="V-26359">
        <Rule id="SV-53121r2_rule">
            <version>WN12-SO-000023</version>
            <ident system="http://cce.mitre.org">CCE-24020-0</ident>
            <ident system="http://iase.disa.mil/cci">CCI-000048</ident>
            <ident system="http://iase.disa.mil/cci">CCI-001384</ident>
            <ident system="http://iase.disa.mil/cci">CCI-001385</ident>
            <ident system="http://iase.disa.mil/cci">CCI-001386</ident>
            <ident system="http://iase.disa.mil/cci">CCI-001387</ident>
            <ident system="http://iase.disa.mil/cci">CCI-001388</ident>
        </Rule>
    </Group>
    <Group id="V-14235">
        <Rule id="SV-52947r1_rule">
            <version>WN12-SO-000078</version>
            <ident system="http://cce.mitre.org">CCE-23877-4</ident>
            <ident system="http://iase.disa.mil/cci">CCI-001084</ident>
        </Rule>
    </Group>
    <Group id="V-14236">
        <Rule id="SV-52948r1_rule">
            <version>WN12-SO-000079</version>
            <ident system="http://cce.mitre.org">CCE-24519-1</ident>
            <ident system="http://iase.disa.mil/cci">CCI-002038</ident>
        </Rule>
    </Group>
</Benchmark>

VBScript代码:

On Error Resume Next

Set oShell = CreateObject("WScript.Shell")
strOutputFolder = oShell.ExpandEnvironmentStrings("%USERPROFILE%")

Set objFSO = CreateObject("Scripting.FileSystemObject")

If Not objFSO.FolderExists(strOutputFolder & "\Desktop\Output\") Then objFSO.CreateFolder(strOutputFolder & "\Desktop\Output\")

Set objExcel = CreateObject("Excel.Application")
objExcel.DisplayAlerts = False

objExcel.Workbooks.Add

Set objWorkbook = objExcel.Workbooks.Add()
Set colSheets = objWorkbook.Sheets
colSheets.Add ,,1

Sheet = 1

Set objSheet = objExcel.ActiveWorkbook.Worksheets(Sheet)
objSheet.Name = "Test"

strExcelPath = strOutputFolder & "\Desktop\Output\Test.xlsx"

objSheet.Cells(1, 1).Value = "Results" 'Row 1 Column 1 (A)

objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
objExcel.DisplayAlerts = True

objExcel.Application.Quit

Set objSheet = Nothing
Set objExcel = Nothing

strSheetName = "Test"

Set objExcel = CreateObject("Excel.Application")
Const xlUp = -4162
Set objWB = objExcel.Workbooks.Open(strExcelPath, False, False)
Set objWS = objWB.Sheets(strSheetName)

objExcel.Visible = False

intNextRow = objWS.Cells(65536, "A").End(xlUp).Row + 1

Set xmlDoc = CreateObject("Microsoft.XMLDOM")
xmlDoc.SetProperty "SelectionLanguage", "XPath"
xmlDoc.Async = "False"
xmlDoc.Load("OutputFileForCCI.xml")

Set Rules = xmlDoc.SelectNodes("//Benchmark/Group/Rule")

For Each Rule In Rules
    Set CCIS = Rule.SelectNodes("ident[@system='http://iase.disa.mil/cci']")

    For Each CCI In CCIS
        objWS.Cells(intNextRow, "A").Value = CCI.Text
        intNextRow = intNextRow + 1
    Next
Next

objWB.Save
objWB.Close
objExcel.Quit
Set objWS = Nothing
Set objWB = Nothing
Set objExcel = Nothing

预期结果(每个值应在单元格中位于其单独的行上):

A1单元格内容:

CCI-000048
CCI-001384
CCI-001385
CCI-001386
CCI-001387
CCI-001388

单元格A2内容:

CCI-001084

A3单元格内容:

CCI-002038

实际结果是将这些物品放置在自己的单元格中。

1 个答案:

答案 0 :(得分:0)

不要在内循环中增加行计数器。相反,应从内部循环中的变量中收集值,并在内部循环完成后将其分配给单元格。

For Each Rule In Rules
    Set CCIS = Rule.SelectNodes("ident[@system='http://iase.disa.mil/cci']")

    ReDim arr(CCIS.Length - 1)
    For i=0 To UBound(arr)
        arr(i) = CCIS(i).Text
    Next

    objWS.Cells(intNextRow, "A").Value = Join(arr, vbLf)
    intNextRow = intNextRow + 1
Next