VBA читает проблемы с производительностью XML - PullRequest
Новая
       30

VBA читает проблемы с производительностью XML

1 голос
/ 08 марта 2019

Я уже искал здесь много ответов, но, похоже, ни один из них не охватывает мою проблему. Фактически, многие из предложений, приведенных в других ответах, уже реализованы в моем коде. У меня есть огромный 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

Этот код даже очень похож на код, найденный здесь в ответе, и этот ответ дает результаты намного быстрее, чем мой. Это не проблема ПК, как я пытался на других компьютерах. Кто-нибудь прошел через что-то подобное или есть идеи, в чем может быть проблема? XML работает нормально и быстро, когда зацикливается на PHP, поэтому не проблема XML.

1 Ответ

0 голосов
/ 08 марта 2019

Метод массива

Проход по диапазону через 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
...