[NON RESOLU] groupement de lignes (plan)

Le
Jean-François LEGRAS
Bonjour à tous,


Je me permets de reposter mon problème car il reste pour l'instant sans
solution, et ce malgré l'avancement réel qu'a présenté l'ai de de François,
que je remercie.




Je souhaiterais créer un plan sur un fichier de type
http://cjoint.com/?dittoKPr4O respectant les critères suivants :


1) lorsqu'il est refermé, je n'ai que le compte leader et les comptes de
Niv2 qui soient visibles ;
2) lorsqu'il est déplié sur le 2ème niveau (click du "2" en haut à gauche),
j'ai le leader, les comptes de niv 2 et les comptes de niv 3 qui sont
visibles ;
3) lorsqu'il est déplié sur le 3ème niveau (click "3"), j'ai le leader, les
comptes de niv 2, 3 et 4 qui sont visibles.
4) enfin, lorsqu'il est déplié complètement (click "4"), j'ai tous les
comptes de
la hiérarchie.

Et ce dans tous les cas de figure (que des comptes de niv supérieur
s'interposent ou non entre des comptes de niv inférieur).


J'avais tout d'abord créé la macro suivante, mais ne fonctionne pas
totalement :

Sub MacroRegroupement()




Range("A65535").End(xlUp).Select

If ActiveCell.Offset(0, 2) = "" Then
Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0,
2).End(xlUp).Offset(1, 0)).EntireRow.Select
Selection.Rows.Group
Else
End If



Do While ActiveCell.Offset(0, 2).End(xlUp).Row > Range("A6").Row

If ActiveCell.Offset(-2, 2) = "" Then
Range(ActiveCell.Offset(-2, 0), ActiveCell.Offset(-1,
2).End(xlUp).Offset(1, 0)).EntireRow.Select
Selection.Rows.Group

Else
Range(ActiveCell.Offset(-1, 2).End(xlUp).Offset(-1, 0),
ActiveCell.Offset(-1, 2).End(xlUp).End(xlUp).Offset(1, 0)).EntireRow.Select
Selection.Rows.Group

End If
Loop



'

Range("A65535").End(xlUp).Select

If ActiveCell.Offset(0, 3) = "" Then

If ActiveCell.Offset(-1, 2).End(xlUp).Row > ActiveCell.Offset(-1,
3).End(xlUp).Row Then
ActiveCell.Offset(0, 3).End(xlUp).Offset(1, -3).Select

Else
Range(ActiveCell.Offset(0, 3), ActiveCell.Offset(0,
3).End(xlUp).Offset(1, 0)).EntireRow.Select
Selection.Rows.Group

End If

Else

Else
ActiveCell.Offset(0, 3).End(xlUp).Offset(1, -3).Select

End If




Do While ActiveCell.Offset(0, 3).End(xlUp).Row > Range("D6").Row

If ActiveCell.Offset(-2, 3) = "" Then

If ActiveCell.Offset(0, 2).End(xlUp).Row > ActiveCell.Offset(0,
3).End(xlUp).Row Then
ActiveCell.Offset(-1, 3).End(xlUp).Offset(1, -3).Select

Else
Range(ActiveCell.Offset(-2, 0), ActiveCell.Offset(-1,
3).End(xlUp).Offset(1, 0)).EntireRow.Select
Selection.Rows.Group

End If
Else

ActiveCell.Offset(-1, 3).End(xlUp).Offset(1, -3).Select

End If

Loop



ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=1


End Sub





Puis en suivant les conseils de François, j'ai écrit la macro suivante :



Colonne = "C"
Range(Colonne & Range("A65535").End(xlUp).Row).Select
Do While ActiveCell.Row > 6
If ActiveCell = "" Then
Range(ActiveCell, ActiveCell.End(xlUp).Offset(1, 0)).EntireRow.Activate
Selection.Group
Else
If ActiveCell.Offset(-1, 0) <> "" Then
ActiveCell.End(xlUp).Activate
End If
End If
Range(Colonne & ActiveCell.Offset(-1, 0).Row).Activate
Loop

Colonne = "D"
Range(Colonne & Range("A65535").End(xlUp).Row).Select
Do While ActiveCell.Row > 6
If ActiveCell = "" Then
Range(ActiveCell, ActiveCell.End(xlUp).Offset(1, 0)).EntireRow.Activate
Selection.Group
Else
If ActiveCell.Offset(-1, 0) <> "" Then
ActiveCell.End(xlUp).Activate
End If
End If
Range(Colonne & ActiveCell.Offset(-1, 0).Row).Activate
Loop




=> J'arrive à un résultat intéressant pas très éloigné de ce que
j'aimerais obtenir :

- Mon point N° 2 est bien atteint (les comptes de Niv 3 sont groupés entre
eux).
- Par contre, mon point N° 1 n'est pas atteint : la dernière ligne est
regroupée directement avec la ligne 6. Je n'ai donc pas les comptes de Niv
2 groupés entre eux.




Enfin, si j'ajoute le code :


Colonne = "E"
Range(Colonne & Range("A65535").End(xlUp).Row).Select
Do While ActiveCell.Row > 6
If ActiveCell = "" Then
Range(ActiveCell, ActiveCell.End(xlUp).Offset(1, 0)).EntireRow.Activate
Selection.Group
Else
If ActiveCell.Offset(-1, 0) <> "" Then
ActiveCell.End(xlUp).Activate
End If
End If
Range(Colonne & ActiveCell.Offset(-1, 0).Row).Activate
Loop



=> J'obtiens mon point 3 (regroupement des comptes de niv 4 avec click
"3" ), mais mon point 2 a disparu et le point 1 reste non atteint (cette
fois-ci la dernière ligne est groupée avec la ligne 5).


Bref, je n'ai qu'une partie de la solution mais pas la solution dans sa
globalité.


En espérant que tout ce que j'écris est clair et compréhensible


Merci d'avance pour votre aide !

JF
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
francois.forcet
Le #5231301
Rebonjours Jean François
Dommage que tu es reposé un nouveau fil car je t'ai apporté je pense
ta solution sur ton fil précédent
Ton impatience te perdra !!!!
Bon prince je te redonne ma dernière proposition qui devrait
normalement te satisfaire

Aprés avoir actualisé le paramètre Colonne :

Colonne = "C"
Range(Colonne & Range("A65535").End(xlUp).Row).Select
Do While ActiveCell.Row > 6
Départ = ActiveCell.Address
Do While ActiveCell = "" And ActiveCell.End(xlToLeft).Address =
Range("A" & ActiveCell.Row).Address
ActiveCell.Offset(-1, 0).Activate
Loop
If Départ <> ActiveCell.Address Then
Range(Départ, ActiveCell.Offset(1, 0)).EntireRow.Activate
Selection.Group
End If
Range(Colonne & ActiveCell.Offset(-1, 0).Row).Activate
Loop

Ce code devrait te convenir
A répéter autant de fois qu'il y a de colonne à traiter

Dis moi !!!!
Jean-François LEGRAS
Le #5230761
GENIAL !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!



MERCI BEAUCOUP FRANCOIS !!!!!!!!!



C'est vraiment fantastique !!! Ca marche parfaitement !!!

Et désolé mille fois pour avoir reposté, je me disais que tu avais peut-être
abandonné...

Bon maintenant, il va falloir que je me pose sérieusement et essaie de
comprendre ce code magique et là c'est pas gagné ;-)


Merci encore !

A+

JF

Rebonjours Jean François
Dommage que tu es reposé un nouveau fil car je t'ai apporté je pense
ta solution sur ton fil précédent
Ton impatience te perdra !!!!
Bon prince je te redonne ma dernière proposition qui devrait
normalement te satisfaire

Aprés avoir actualisé le paramètre Colonne :

Colonne = "C"
Range(Colonne & Range("A65535").End(xlUp).Row).Select
Do While ActiveCell.Row > 6
Départ = ActiveCell.Address
Do While ActiveCell = "" And ActiveCell.End(xlToLeft).Address Range("A" & ActiveCell.Row).Address
ActiveCell.Offset(-1, 0).Activate
Loop
If Départ <> ActiveCell.Address Then
Range(Départ, ActiveCell.Offset(1, 0)).EntireRow.Activate
Selection.Group
End If
Range(Colonne & ActiveCell.Offset(-1, 0).Row).Activate
Loop

Ce code devrait te convenir
A répéter autant de fois qu'il y a de colonne à traiter

Dis moi !!!!
Patrick BASTARD
Le #5230731
Bonjour, *Jean-François LEGRAS*


GENIAL !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MERCI BEAUCOUP FRANCOIS !!!!!!!!! C'est vraiment fantastique !!! Ca marche
parfaitement !!!



Dommage que le fil reste en "NON RESOLU"...

--
Bien amicordialement,
P. Bastard

Avant d'imprimer ce mail, ayez une pensée pour les arbres.

francois.forcet
Le #5230661
On 10 mar, 22:30, "Jean-François LEGRAS"
GENIAL !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

MERCI BEAUCOUP FRANCOIS !!!!!!!!!

C'est vraiment fantastique !!! Ca marche parfaitement !!!

Et désolé mille fois pour avoir reposté, je me disais que tu avais p eut-être
abandonné...

Bon maintenant, il va falloir que je me pose sérieusement et essaie de
comprendre ce code magique et là c'est pas gagné ;-)

Merci encore !

A+

JF

Rebonjours Jean François
Dommage que tu es reposé un nouveau fil car je t'ai apporté je pense
ta solution sur ton fil précédent
Ton impatience te perdra !!!!
Bon prince je te redonne ma dernière proposition qui devrait
normalement te satisfaire

Aprés avoir actualisé le paramètre Colonne :

Colonne = "C"
Range(Colonne & Range("A65535").End(xlUp).Row).Select
Do While ActiveCell.Row > 6
Départ = ActiveCell.Address
Do While ActiveCell = "" And ActiveCell.End(xlToLeft).Address =
Range("A" & ActiveCell.Row).Address
ActiveCell.Offset(-1, 0).Activate
Loop
If Départ <> ActiveCell.Address Then
Range(Départ, ActiveCell.Offset(1, 0)).EntireRow.Activate
Selection.Group
End If
Range(Colonne & ActiveCell.Offset(-1, 0).Row).Activate
Loop

Ce code devrait te convenir
A répéter autant de fois qu'il y a de colonne à traiter

Dis moi !!!!


Rebonjours Jean François
Trés heureux que celà te convienne
Abandonner n'est pas nature
Je serais plutôt d'un tempérament téniousse et accrocheur
Et en désespoire de cause je n'abonnerais pas comme un mal propre sans
rien dire
J'ai tout simplement était en proie à d'autres activités m'éloignant
quelque peu de mon ordinateur
Sache donc à l'avenir si nos chemin se recroisent que sans avis
contraire de ma part ou proposition d'un autre contributeur répondant
à ta demande je serais sur ma planche de travail pour tenter de
t'apporter la solution

A bientôt peut être

Publicité
Poster une réponse
Anonyme