Nettoyer une base XML en fonction d'un ID

Version imprimable

Hello Folks !

J'ai besoin de votre savoir inestimable afin de cleaner une BDD.

Je vous donne un exemple, j'ai ces lignes (XML) que je copie/colle dans excel :

Code:

1
2
3
4
5
6
7
      <object ID="5445/0/0" KEY="45A61E3D1DZDZ82A5F6E61755DZ1F14E">
      <field value="2131" visible="true" />
      <field value="02i NAME" />
      <field value="EMAIL@EMAIL.FR" />
      <field value="NOM" />
      <field value="PRENOM" />
      <field value="1" />

J'ai créer quelque chose (en VB par exemple) qui dise :

1. On trouve <field value="
2. Si l'ID dans <field value="XXX" est supérieur à 2130 on garde la ligne en question ainsi que les 4 lignes en dessous.

Autrement dit si j'ai :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
      <object ID="5445/0/0" KEY="45A61E3D1DZDZ82A5F6E61755DZ1F14E">
      <field value="2131" visible="true" />
      <field value="02i NAME" />
      <field value="EMAIL@EMAIL.FR" />
      <field value="NOM" />
      <field value="PRENOM" />
      <field value="1" />
      <field value="BLABLABLABLA" />
      <object ID="5445/0/0" KEY="45A61E3D1DZDZ82A5F6E61755DZ1F14E">
      <field value="2129" visible="true" />
      <field value="02i NAME" />
      <field value="EMAIL@EMAIL.FR" />
      <field value="NOM" />
      <field value="PRENOM" />
      <field value="1" />

Après passage de mon code j'aurais :

Code:

1
2
3
4
5
      <field value="2131" visible="true" />
      <field value="02i NAME" />
      <field value="EMAIL@EMAIL.FR" />
      <field value="NOM" />
      <field value="PRENOM" />

Merci à vous !

Un solution un peu artisanale:

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
Option Explicit
 
Public Sub Nettoyer()
 
    Dim i As Integer
    Dim lngLig As Long
    Dim C As Range
    Dim strChaine As String
 
    lngLig = Range("A" & Rows.Count).End(xlUp).Row
 
    Do
        Set C = Columns(1).Find("object ID", , , xlPart)
        If C Is Nothing Then Exit Sub
 
        strChaine = Cells(C.Row + 1, 1).Value
        strChaine = Mid(strChaine, 21, Len(strChaine))
 
        If Val(strChaine) <= 2130 Then
            Range(Cells(C.Row, 1), Cells(C.Row + 7, 1)).EntireRow.Delete
        Else
            Range(Cells(C.Row + 6, 1), Cells(C.Row + 7, 1)).EntireRow.Delete
            Rows(C.Row).Delete
        End If
    Loop
 
End Sub

La ligne suivante est peut être à adapter:

Code:

strChaine = Mid(strChaine, 21, Len(strChaine))

sauf si ton copier/coller est identique à ton fichier Excel.

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
Sub tt()
    'Si l 'ID dans <field value="XXX" est supérieur à 2130 on garde la ligne en question ainsi que les 4 lignes en dessous.
    ligne = 1
 
    While ligne < ThisWorkbook.Worksheets(2).Range("A" & Cells.Rows.Count).End(xlUp).Row
 
        st = ThisWorkbook.Worksheets(2).Cells(ligne, 1).Text
 
        result = DetecteFieldValue(st, "<field value=" & Chr(34), 2130)
 
        If result = True Then
 
            For ligne = ligne To ligne + 4
 
                ThisWorkbook.Worksheets(2).Rows(ligne & ":" & ligne).Select
                LigneDestination = LigneDestination + 1
                ThisWorkbook.Worksheets(2).Rows(ligne & ":" & ligne).Copy ThisWorkbook.Worksheets(4).Cells(LigneDestination, 1)
 
            Next
        End If
        ligne = ligne + 1
    Wend
 
End Sub
 
Function DetecteFieldValue(st, field_value, plusGrandQue)
 
    b = InStr(UCase(st), UCase(field_value))
 
    If b > 0 Then
        valeur = Mid(st, b + Len(field_value))
 
        If Val(valeur) > plusGrandQue Then
            DetecteFieldValue = True
        End If
 
    End If
 
End Function