Discussion :

[IronHeavy]

Bonjour le Forum,

La lecture du post:
https://www.developpez.net/forums/d1...sieurs-lignes/

apporte une solution partielle à ma problématique :
https://www.developpez.net/forums/d1...l-exploitable/

Repartant donc de cette proposition, je souhaiterai l'étendre à plusieurs colonnes tout en gardant l'alignement original des données.

je pars d'un PDF, extrait en XLS via un site web gratuit. Je compte me servir des tableaux obtenus comme outil de veille réglementaire. Le point bloquant actuel est que les cellules de la colonne B et C sont fusionnées verticalement au petit bonheur, le texte contenu est renvoyé à la ligne sans changement de ligne sur Excel, ce qui m’empêche tout traitement des données de ligne unique!

Votre solution serait donc de repérer les "Retours Chariots" afin d'insérer les sauts de lignes utiles - j'ai testé sur une colonne et cela fonctionne bien ! Je souhaiterai que mon tableau se voie en quelque sorte "défusionné" et enfin exploitable!

Voici ou j'en suis rendu :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub TestSpliterLesCellulesAvecRetourChariot()
 
    SpliterLesCellulesAvecRetourChariot Sheets("Source"), Sheets("Cible")
 
End Sub
 
Sub SpliterLesCellulesAvecRetourChariot(ByVal FeuilleSource As Worksheet, ByVal FeuilleCible As Worksheet)
 
Dim RetoursChariots As Variant
Dim I As Long, J As Long
Dim PremiereLigneSource As Long, DerniereLigneSource As Long
Dim LigneCible As Long
 
    With FeuilleCible
         LigneCible = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
    End With
 
    With FeuilleSource
         PremiereLigneSource = 1
         DerniereLigneSource = .Cells(.Rows.Count, 2).End(xlUp).Row
         PremiereColonneSource = 1
         DerniereColonneSource = 3
 
         For I = PremiereLigneSource To DerniereLigneSource
         For K = PremiereColonneSource To DerniereColonneSource
             RetoursChariots = Split(.Cells(I, K), Chr(10))
             If UBound(RetoursChariots) > 0 Then
                For J = LBound(RetoursChariots) To UBound(RetoursChariots)
                    With FeuilleCible
                         FeuilleCible.Cells(LigneCible, K) = Trim(RetoursChariots(J))
                         LigneCible = LigneCible + 1
                    End With
                Next J
             Else
                FeuilleCible.Cells(LigneCible, K) = Trim(.Cells(I, K))
                LigneCible = LigneCible + 1
             End If
             Next K
          Next I
   End With
End Sub

J'observe un décalage de 1 ligne entre la colonne B et la colonne 1 et encore 1 ligne entre la C et la B ... ? il doit s'agir d'une erreur de ma part. Puis des sauts de lignes coordonnés mais surnuméraires...

D'autre part, mais cela vient probablement du fichier d'origine, certaines cellules en C ne sont pas en face de leurs sœurs en B (43 occurences). Mais ailleurs ça tombe juste... (32 occurences)?

fichier TEST:

TEST NOMENCLATURE.xlsm
Merci pour vos observation / conseils !

[EricDgn]

Bonjour,

A mon avis vous aurez beaucoup de peine avec cette feuille Excel tirée de la conversion d'un pdf sans réelle structure. Surtout qu'il faudra recommencer à chaque "suivi".

Il est vraiment plus simple de partir de la page web de Légifrance (tout en bas, un lien vers ANNEXES).

En attaché, le résultat obtenu par un simple copié-collé de la partie qui vous intéresse. Il ne sera pas compliqué de supprimer les lignes inutiles.

Bonne continuation.

[IronHeavy]

Bonjour,

Il est vraiment plus simple de partir de la page web de Légifrance (tout en bas, un lien vers ANNEXES).

Effectivement... quand on sait où trouver la source c'est beaucoup plus carré! (on m'avait vanté l'aspect pratique d'utiliser AIDA INERIS versus LEGIFRANCE pour les ICPE... pas dans ce cas néanmoins!)

Merci!

[IronHeavy]

Et... une proposition pour supprimer les lignes vides et superflues (non intégrées dans le tableau) :

Je "vire" ce qui n'est vide, les interlignes et les chapitres en trop avec:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub EntireRow()
 
     For i = Range("A" & Rows.Count).End(xlUp).Row To 10 Step -1
             If Cells(i, 2) = "" Then
             Cells(i, 2).EntireRow.Delete
              End If
              If Cells(i, 2) = "A-NOMENCLATURE DES INSTALLATIONS CLASSEES" Then
             Cells(i, 2).EntireRow.Delete
              End If
              If Cells(i, 2) = "Désignation de la rubrique" Then
             Cells(i, 2).EntireRow.Delete
              End If
       Next i
    End Sub

Et ça ressort tout propre!

YAPLUKA vérifier qu'il ne manque rien d'essentiel...

Merci!

[IronHeavy]

Rebonjour!

De manière à piloter la navigation dans cette base de données j'aurais besoin d'identifier spécifiquement mes lignes de réglementation. Pour ce faire, il faudrait que ma BD initiale migre vers un modèle de ce genre:

ACTUEL:



PROJET:



Les modifs de concernent que la colonne A, qui reprend les codes des sous paragraphes de la colonne B

De manière à ce que lorsque je sélectionnerai, par exemple, la ligne 1185.3.1.a, une seconde macro puisse aisément rechercher et afficher les antécédents (1185 - 1185.3 - 1185.3.1)

du style:


De cette manière, mon projet de recherche intuitive me permettra de remonter le régime de classification complet de la matière concernée avec:

RUBRIQUE - DESIGNATION - CATEGORIE - sous catégorie - sous rubrique = REGIME !

Merci pour vos lumières!

[patricktoulon]

bonjour
une macro simple pour copier ta page complète

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub legifrance()
    URL = "https://www.legifrance.gouv.fr/affichCode.do;jsessionid=8B8AAD10F5FDAA634855AAAC7312EDB3.tplgfr41s_3?idSectionTA=LEGISCTA000006108640&cidTexte=LEGITEXT000006074220&dateTexte=20190606"
    With CreateObject("internetexplorer.application")
        .navigate URL
        ' .Visible = True
        Do: DoEvents: Loop While .readystate <> 4
        For Each elem In .document.all
            If elem.tagname = "table" Then elem.Style.baCkgroundcolor = "rgb(220,220,220)"
        Next
        .ExecWB 17, 0  '-- selectionner tout
        .ExecWB 12, 2  '-- copy
        .Quit
    End With
    With Sheets("Legifrance")
        For Each shp In .Shapes: shp.Delete: Next
        .Cells.Clear:        .Cells(1).Select
        Application.ScreenUpdating = False
        .Paste
        With .Columns("A:C")
            .ColumnWidth = 50
            .RowHeight = 40
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
    End With
End Sub