Problème affichage tableau
scrat51
Messages postés
3
Date d'inscription
Statut
Membre
Dernière intervention
-
scrat51 Messages postés 3 Date d'inscription Statut Membre Dernière intervention -
scrat51 Messages postés 3 Date d'inscription Statut Membre Dernière intervention -
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)
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)
A voir également:
- Problème affichage tableau
- Tableau word - Guide
- Tableau ascii - Guide
- Trier un tableau excel - Guide
- Tableau croisé dynamique - Guide
- Imprimer tableau excel sur une page - Guide
2 réponses
Je vous passe le fichier excel : https://www.cjoint.com/?3EwpE4NSLGs
Le fichier source : https://www.cjoint.com/?DEwpIX8Ju9U
Merci pour votre aide
Le fichier source : https://www.cjoint.com/?DEwpIX8Ju9U
Merci pour votre aide