Problème affichage tableau

Fermé
scrat51 Messages postés 3 Date d'inscription jeudi 22 mai 2014 Statut Membre Dernière intervention 23 mai 2014 - 22 mai 2014 à 14:28
scrat51 Messages postés 3 Date d'inscription jeudi 22 mai 2014 Statut Membre Dernière intervention 23 mai 2014 - 23 mai 2014 à 09:17
Voila, j'ai un soucis d'affichage. Les résultats du fichier venant de l'onglet "RESULT" ne sont pas dans la bonne colonne. les résultats sont sont affichés sur une seule ligne. Je pense que j'ai une petite erreur d'indexation. Je vous passe le code.

Pourriez vous m'aider corriger cette erreur SVP ?

Merci beaucoup !

Cordialement

Jean-Philippe


Option Explicit

Type XMLTab
EXEC_Log As String
Start As String
duration_severity As String
CMD_event As String
RESULT As String
End Type

Private Function RegExpTest(Ligne As String, Debut As String, Fin As String) As String
'Nécessite de cocher "Microsoft VBScript Regular Expressions 5.5" dans "Outils\Références".
Dim RegEx As RegExp
Set RegEx = New RegExp
Dim Matches As IMatchCollection2
Dim MyString As String
With RegEx
.IgnoreCase = True
.Global = False 'True matches all occurances, False matches the first occurance
.Pattern = Debut + ".*?" + Fin 'Vos condition de selection"
Set Matches = .Execute(Ligne)
If Matches.Count <> 0 Then
MyString = Matches.Item(0)
.Pattern = Debut
MyString = .Replace(MyString, "")
.Pattern = Fin
MyString = .Replace(MyString, "")
RegExpTest = MyString
Else
RegExpTest = ""
End If
End With

End Function

Private Function MaTable(MesLignes() As String) As String()
Dim Prérangement() As XMLTab
Dim Ligne As Variant
Dim Count As Integer
Dim Table() As String
Count = 0

ReDim Prérangement(Count)
For Each Ligne In MesLignes
ReDim Preserve Prérangement(Count)
Prérangement(Count).EXEC_Log = RegExpTest(CStr(Ligne), "<", " start=")
Prérangement(Count).Start = RegExpTest(CStr(Ligne), " start=""", """ ")

Prérangement(Count).duration_severity = RegExpTest(CStr(Ligne), " severity=""", """>")
If Prérangement(Count).duration_severity = "" Then
Prérangement(Count).duration_severity = RegExpTest(CStr(Ligne), " duration=""", """ CMD=""")
End If

Prérangement(Count).CMD_event = RegExpTest(CStr(Ligne), """>", "</log")
If Prérangement(Count).CMD_event = "" Then
Prérangement(Count).CMD_event = RegExpTest(CStr(Ligne), "CMD=""", """ RESULT=")
End If

Prérangement(Count).RESULT = RegExpTest(CStr(Ligne), "RESULT=""", """/>")
Count = Count + 1
Next

ReDim Table(Count - 1, 4)
Count = 0
For Count = 0 To UBound(Prérangement)
Table(Count, 0) = Prérangement(Count).EXEC_Log
Table(Count, 1) = Prérangement(Count).Start
Table(Count, 2) = Prérangement(Count).duration_severity
Table(Count, 3) = Prérangement(Count).CMD_event
Table(Count, 4) = Prérangement(Count).RESULT
Next
MaTable = Table
End Function

Public Sub XMLtoCSV()
Dim FichierXml As String
Dim TextXml As String
Dim MesLignes() As String
Dim oSheet As Excel.Worksheet
Set oSheet = ThisWorkbook.Sheets("Feuil1")
Dim MonTableau() As String
Dim MyUsedRange As String

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With

'Importation du fichier XML en mémoire
FichierXml = Application.GetOpenFilename("XML Files (*.xml),*.xml", , "Select XML file", , False)
If FichierXml <> "Faux" Then
Open FichierXml For Input As #1
Do While Not EOF(1)
Dim Text As String
Line Input #1, Text
TextXml = TextXml & Text
Loop
Close #1

MesLignes = MyRegex(TextXml) 'Tableau extractions
MonTableau = MaTable(MesLignes)

MyUsedRange = oSheet.UsedRange.Address
MyUsedRange = Replace(MyUsedRange, "$A$1:", "$A$2:")
On Error Resume Next
oSheet.Cells.Range(MyUsedRange).Delete
On Error GoTo 0
oSheet.Cells.Range("A2:E" + Trim(Str(UBound(MonTableau) + 1))).Value2 = MonTableau
End If

With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub

Private Function MyRegex(Text As String) As String()
'Nécessite de cocher "Microsoft VBScript Regular Expressions 5.5" dans "Outils\Références".
Dim RegEx As RegExp
Set RegEx = New RegExp
Dim Matches As IMatchCollection2
Dim match As Variant
Dim Count As Integer
Dim MyReturn() As String
With RegEx
.IgnoreCase = True
.Global = True 'True matches all occurances, False matches the first occurance
.Pattern = "<log start.*?<\/log|< EXEC start.*?<\/EXEC|<EXEC start.*?\/>" 'Vos condition de selection
Set Matches = .Execute(Text)
End With
If Not Matches.Count = 0 Then
ReDim MyReturn(Matches.Count - 1)
Count = 0
For Each match In Matches
MyReturn(Count) = match.Value
Count = Count + 1
Next
End If
MyRegex = MyReturn
End Function


Je pense que l'erreur vient de cette ligne :

ReDim Table(Count - 1, 4)

2 réponses

scrat51 Messages postés 3 Date d'inscription jeudi 22 mai 2014 Statut Membre Dernière intervention 23 mai 2014
22 mai 2014 à 15:35
Je vous passe le fichier excel : https://www.cjoint.com/?3EwpE4NSLGs


Le fichier source : https://www.cjoint.com/?DEwpIX8Ju9U

Merci pour votre aide
0
scrat51 Messages postés 3 Date d'inscription jeudi 22 mai 2014 Statut Membre Dernière intervention 23 mai 2014
23 mai 2014 à 09:17
personne ne peut m'aider ?
0