VBA 读取 XML 性能问题

Question

我已经在这里寻找了很多答案，但似乎没有一个能解决我的问题。事实上，其他答案中给出的许多建议已经在我的代码中实现。 我有一个巨大的xml文件，我必须循环访问，而且速度真的很低，每行写入(或每个节点)大约1秒。当我得到一个小样本时，也会保持这种速度，比如 82 行(每行大约 15 列)。这意味着 82 个主节点，每个节点有 15 个子节点。

我的代码如下：

Dim wsBase As Worksheet
Dim linEscrita As Long
Dim resp As MSXML2.DOMDocument60
Dim lista As IXMLDOMNodeList
Dim nodeAtual As IXMLDOMNode
Dim childNode As IXMLDOMNode
Dim charIni As Long
Dim charAt As Long
Dim colAtual As Long
Application.ScreenUpdating = False
Set wsBase = Worksheets("Name of worksheet")
Set resp = New DOMDocument60
resp.LoadXML (FunctionForGettingXMLfromWebService)
linEscrita = 2
'name from Node I must find and get child nodes
Set lista = resp.SelectNodes("//node1/node2")
For Each nodeAtual In lista
colAtual = 1
If (nodeAtual.HasChildNodes) Then
For Each childNode In nodeAtual.ChildNodes
wsBase.Cells(linEscrita, colAtual) = childNode.text
colAtual = colAtual + 1
Next childNode
End If
linEscrita = linEscrita + 1
Next nodeAtual
Application.ScreenUpdating = True

这段代码甚至与答案上的代码非常相似，在该答案上，代码的结果比我的快得多。这不是基于PC的问题，因为我在其他计算机上也尝试过。有没有人经历过类似的事情或知道可能是什么问题？当与PHP循环时，XML运行良好且快速，因此也不是XML问题。

Answer 1

数组方法

通过 VBA 循环访问范围总是很耗时。因此，下面的代码示例 -尽可能接近您的原始帖子*) - 将所需的 XML 内容写入预定义的 2-dim数组(第[3]和[4]节)，并通过一行代码将其写回工作表(第[5]节)。 此外，在这个非常基本的 XPath 模型中，假设所有 15 个子节点都遵循相同的严格顺序;空行将被省略。

*)您可以通过直接引用 @Absinthe 建议的子节点来加快速度。

代码示例尽可能接近您的 OP

Sub WriteXMLContents2Sheet()
Const MAXCOLUMNS& = 15                          ' << change to columns limit in xml
Dim linEscrita As Long: linEscrita = 2          ' << start row
Application.ScreenUpdating = False
Dim wsBase     As Worksheet
Set wsBase = ThisWorkbook.Worksheets("Name of worksheet")
'[1] load xml
Dim resp       As MSXML2.DOMDocument60
Dim lista      As IXMLDOMNodeList
Dim nodeAtual  As IXMLDOMNode
Dim childNode  As IXMLDOMNode
Set resp = New DOMDocument60
resp.LoadXML (FunctionForGettingXMLfromWebService)
'[2] set nodelist to memory (XPath possibly could be refined :-)
Set lista = resp.SelectNodes("//node1/node2")
'[3] dimension temporary variant (1-based) 2-dim array to hold contents
ReDim tmp(1 To lista.Length, 1 To MAXCOLUMNS)
' [4] loop thru nodelist
Dim c&, r&                                            ' declare row/column counters
r = 1
For Each nodeAtual In lista
c = 1
If nodeAtual.HasChildNodes Then
For Each childNode In nodeAtual.ChildNodes
tmp(r, c) = childNode.Text
c = c + 1                                   ' increment column counter
Next childNode
r = r + 1                                       ' << move row counter into If condition to avoid empty lines
End If
Next nodeAtual
'[5] write array content to sheet
wsBase.Range("A" & linEscrita).Resize(UBound(tmp), UBound(tmp, 2)) = tmp
Application.ScreenUpdating = True
End Sub