Discussion :

[MsieurDams]

Bonjour,

Je suis confronté à une difficulté dans le développement d'une macro me permettant de mapper l'organisation de l'entreprise dans laquelle je travaille.

J'ai reçu un fichier, lequel se présente de al manière suivante :

CODE entité  | Libellé entité | Entité parente
1	       CORP             NEANT
2	       Cabinet          1086
6	       Direction Juri   10
10	       Secrét. Gnal     1086
1086	       Présidence       1

Comme vous le constatez, le traitement que je dois appliquer est récursif, puisque je dois faire la correspondance avec l'entité parente sur plusieurs passes jusqu'à arriver à obtenir la ligne 1 CORP NEANT.

Le code que j'ai écrit effectue bien le traitement sur 5 passes. Mais je n'arrive pas à voir où mon code déraille (il finit par boucler sur le contenu des 2e et 3e passes). Je joins le fichier avec des exemples de ce que je souhaite obtenir ainsi que le code fonctionnel.

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
42
43
44
45
46
47
48
49
50
51
52
53
54
Sub traitement()
Application.ScreenUpdating = False
 
' définition des variables
Dim entite_id, cur_passes, total_passes, end_ligne, cur_ligne As Integer
Dim entite_label As String
Dim found_cell As Range
 
'Paramètres : nombre max de lignes, nombre de passes, colonne à utliliser pour récupérer le code entité
end_ligne = Range("A65536").End(xlUp).Row
total_passes = 5
col_passes = 1
 
' traitement des n passes
For cur_passes = 1 To total_passes
 
    ' déplace le curseur pour tenir compte des différentes passes
    If cur_passes >= 2 Then
 
    col_passes = col_passes + 2
 '   MsgBox col_passes
    End If
 
    'traitement sur l'ensemble des lignes
    For cur_ligne = 2 To end_ligne
        entite_id = Cells(cur_ligne, col_passes + 2)
        Set found_cell = Range(Cells(1, col_passes), Cells(end_ligne, col_passes)).Find(entite_id, lookat:=xlWhole)
 
        If found_cell Is Nothing Then
        Cells(cur_ligne, 1).Select
            With Selection.Interior
            .ColorIndex = 38
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            End With
 
        Else
     ' copie du label de l'entité et de son entité parente   
        found_ligne = found_cell.Row
        found_col = found_cell.Column
 
        Range(Cells(found_ligne, 2), Cells(found_ligne, 3)).Select
        Selection.Copy
        Cells(cur_ligne, col_passes + 3).Select
        ActiveSheet.Paste
 
        End If
    Next cur_ligne
 
Next cur_passes
 
Application.ScreenUpdating = True
 
End Sub

Je pense que mon problème réside dans la gestion du décalage de l'entité à rechercher au fur et à mesure des passes.
Merci pour vos conseils

Bien cordialement.