Arborescence de fournisseur
Bonjour à tous,
Je suis débutant sur VBA Excel et je dois faire un programme pour mon projet.
Pour faire simple, j'ai un fichier Excel avec tous les fournisseurs de mon entreprise de référencés. Ce fichier est composé de 3 pages (grands-parents, parents, enfants). Les grands parents sont les fournisseurs principaux, en dessous de lui nous pouvons retrouver plusieurs parents et en dessous de ces parents nous retrouvons encore plusieurs enfants. Je voudrais créer une macro me permettant d'établir une arborescence de ses fournisseurs sans utiliser la fonction viewtree dans les userforms. Je vous joint un exemple de fichier ci-joint afin de faciliter la compréhension du problème.
Merci d'avance
Cordialement,
Bonjour,
A tester si ça convient :
Sub TreeView()
Dim FeResult As Worksheet
Dim PlgGp As Range
Dim PlgP As Range
Dim PlgEnf As Range
Dim CelGp As Range
Dim CelP As Range
Dim CelEnf As Range
Dim I As Long
Dim J As Long
Set FeResult = Worksheets("Exemple d'arbo")
'défini les plages
With Worksheets("G-parents"): Set PlgGp = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
With Worksheets("Parents"): Set PlgP = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
With Worksheets("Child"): Set PlgEnf = .Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp)): End With
'tris ascendants des plages
PlgGp.Sort PlgGp(1), xlAscending
Worksheets("Parents").Range(PlgP, PlgP.Offset(, 1)).Sort PlgP(1), xlAscending
Worksheets("Child").Range(PlgEnf, PlgEnf.Offset(, 1)).Sort PlgEnf(1), xlAscending
'supprime tout sur la feuille (bordures, coleurs, valeurs, etc...)
FeResult.Cells.Clear
I = 1
For Each CelGp In PlgGp
I = I + 1
FeResult.Cells(I, 1).Value = CelGp.Value
FeResult.Cells(I, 1).Interior.ColorIndex = 6
For Each CelP In PlgP
If CelP.Value = CelGp.Value Then
J = J + 1
FeResult.Cells(I + J, 2).Value = CelP.Offset(, 1).Value
FeResult.Cells(I + J, 2).Interior.ColorIndex = 24
For Each CelEnf In PlgEnf
If CelEnf.Value = CelP.Offset(, 1).Value Then
J = J + 1
FeResult.Cells(I + J, 3).Value = CelEnf.Offset(, 1).Value
FeResult.Cells(I + J, 3).Interior.ColorIndex = 40
End If
Next CelEnf
I = I + J
J = 0
End If
Next CelP
I = I + J
J = 0
Next CelGp
'mise en place des bordures
FeResult.UsedRange.Borders.LineStyle = xlContinuous
End Sub
C'est exactement ce que je souhaitais !
Merci beaucoup pour votre aide