Import fichier XML dans tableau variable très long
Bonjour à tous,
je me permets d'ouvrir une discussion car je ne trouve pas de solution à mon problème.
Je souhaite importer un fichier xml dans un tableau variable pour y travailler les données (fichier que je serai amenée à importer régulièrement pour des contrôles). Le fichier en question fait (aujourd'hui) 25 mo, et la macro important ces données met 20 minutes... J'essaie donc de trouver des solutions à ce problème :
- Puis-je optimiser le code ci-dessous pour diminuer le temps d'exécution?
- Par ailleurs, puis-je n'importer qu'une partie du fichier xml, c'est-à-dire prendre toutes les balises, mais seulement les "lignes" répondant à des conditions? Je n'ai pas réussi à le faire.
Merci d'avance pour vos conseils !
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
| Option Explicit
Option Base 1
Function InverseTab(T, Optional Base As Byte = 1) 'Permet de transposer les dimensions d'un tableau
Dim Temp()
Dim i As Long
Dim j As Long
ReDim Temp(Base To UBound(T, 2), Base To UBound(T))
For i = LBound(T, 2) To UBound(T, 2)
For j = LBound(T) To UBound(T)
Temp(i, j) = T(j, i)
Next j
Next i
InverseTab = Temp
End Function
Sub lecture_contrat()
ActiveWorkbook.PrecisionAsDisplayed = False
Application.DisplayAlerts = False 'Désactive/Active les fenêtres Windows (pour éviter d'avoir une fenêtre de confirmation àla suppression de feuilles par exemple)
Application.ScreenUpdating = False 'Désactive la mise à jour de l'écran
Application.DisplayStatusBar = False 'Désactive la barre d'état
Application.Calculation = xlCalculationManual 'Calcul manuel
Application.EnableEvents = False 'Désactive les évènements
ActiveSheet.DisplayPageBreaks = False 'Désactive les sauts de page
Application.Cursor = xlWait 'sablier
Dim recolte As String
recolte = Worksheets("Paramètres").Range("A6")
Dim sDossier As String
Dim sFichier As String
Dim sDossierFichier As String
Dim colonne As Long
Dim ligne As Long
Dim i As Long
Dim j As Long
Dim tabDonnees() As Variant
Dim oXML As MSXML2.DOMDocument
Dim oNode As MSXML2.IXMLDOMNode
Dim childNode As MSXML2.IXMLDOMNode
Dim oSubNode As MSXML2.IXMLDOMNode
Dim xmlRecolte
'1. Ouverture du fichier xml et lecture du contenu
'Nom fichier à lire
Worksheets("Paramètres").Activate
sDossier = Range("B9") & "/"
sFichier = "Contrat.xml"
sDossierFichier = sDossier & sFichier
'Chargement du fichier
Set oXML = New MSXML2.DOMDocument
oXML.async = False
oXML.Load sDossierFichier
'Lecture du contenu
ligne = 0
For Each oNode In oXML.DocumentElement.ChildNodes
ligne = ligne + 1
ReDim Preserve tabDonnees(55, ligne)
colonne = 0
If ligne = 1 Then
For Each oSubNode In oNode.ChildNodes
colonne = colonne + 1
tabDonnees(colonne, ligne) = oSubNode.BaseName
Next
Else
For Each oSubNode In oNode.ChildNodes
colonne = colonne + 1
tabDonnees(colonne, ligne) = oSubNode.Text
Next
End If
Next
'2. Affichage des données dans Excel
Worksheets("Contrat").Activate
'Nettoyage des données précédentes
Range("A2:BC" & Range("A2").End(xlDown).Row).Clear
'Affichage des nouvelles données
Range("A1:BC" & UBound(tabDonnees, 2)) = InverseTab(tabDonnees)
ActiveWorkbook.PrecisionAsDisplayed = True
Application.DisplayAlerts = True 'Désactive/Active les fenêtres Windows (pour éviter d'avoir une fenêtre de confirmation à la suppression de feuilles par exemple)
Application.ScreenUpdating = True 'Désactive la mise à jour de l'écran
Application.DisplayStatusBar = True 'Désactive la barre d'état
Application.Calculation = xlCalculationAutomatic 'Calcul manuel
Application.EnableEvents = True 'Désactive les évènements
ActiveSheet.DisplayPageBreaks = True 'Désactive les sauts de page
Application.Cursor = xlDefault 'sablier
End Sub |
