关于xml格式文件导入电子表格中

qjy321

各位高手帮忙将xml格式文件，导入电子表格中固定格式。

x-xx-xx

用表格打开就可以复制了

qjy321

x-xx-xx 发表于 2022-2-9 20:48
用表格打开就可以复制了

所问非所答

excel002009

代码：

1. Sub extractXml()
   
2.     Dim xdoc As Object, arr()
   
3.     Set xdoc = CreateObject("MSXML2.DOMDocument")
   
4.     '前期绑定
   
5.     'Dim xdoc As New DOMDocument60 '声明的同时创建XML对象
   
6.     Dim b As Boolean, root
   
7.     b = xdoc.Load(ThisWorkbook.Path & "\数据源.xml")
   
8.     If b = True Then
   
9.         Set root = xdoc.DocumentElement '获取根节点
   
10.         Dim i As Integer, j As Integer
    
11.         ReDim arr(1 To root.ChildNodes(0).ChildNodes.Length + 1, 1 To root.ChildNodes(0).ChildNodes(0).Attributes.Length)
    
12.         '获取列标题
    
13.         With root.ChildNodes(0).ChildNodes(0) '根节点的子节点
    
14.              For i = 0 To .Attributes.Length - 1
    
15.                 arr(1, i + 1) = .Attributes(i).nodeName
    
16.              Next i
    
17.         End With
    
18.         '获取行数据
    
19.         For i = 0 To root.ChildNodes(0).ChildNodes.Length - 1
    
20.              With root.ChildNodes(0).ChildNodes(i)
    
21.                  For j = 0 To .Attributes.Length - 1
    
22.                     arr(i + 2, j + 1) = .Attributes(j).Text
    
23.                  Next j
    
24.              End With
    
25.         Next i
    
26.         With Worksheets("导入XML数据")
    
27.             .Cells.Clear
    
28.             Union(.Columns("a:a"), .Columns("c:c"), .Columns("p:p")).NumberFormatLocal = "@"
    
29.             .Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    
30.         End With
    
31.     Else
    
32.         MsgBox "加载失败,请确认同级目录是否有待读取xml文件"
    
33.     End If
    
34. 
    
35. End Sub
    

复制代码

附件：

wodewan