Problème insoluble ??

[alias_2003]

Bonjour à tous,
Voici mes données initiales ! Il s'agit d'une gestion de stock.
Ci joint, un fichier avec un exemple et le résultat que j'essaie d'obtenir désespérément...

Dans cet ex, j'ai 15 produits (lignes 12 à 26), que j'utilise progressivement . Je note chaque utilisation (lignes 27 à 29) de chaque produit.

Mon tableau va donc évoluer au cours du temps.
Pour plus de lisibilité, j'aimerais regrouper les lignes correspondant à un même N° produit et ne laisser affichée que la ligne correspondant à la dernière saisie.

Par ex, ici j'ai 2 lignes correspondant au produit N°6, j'aimerais donc
1. réorganiser automatiquement mon tableau par N° de produit
et placer les 2 lignes l'une en dessous de l'autre, la ligne correspodant à la dernière saisie devant être en 1er

2. J'essaie (en vain) d'écrire un code qui ajouterait une forme "+" dès que le n° d'un produit est renseigné 2 fois

3. Masquer toutes les lignes correspondant au produit sauf la celle correspondant à la dernière saisie

4. Lorsque l'on clique sur ce "+", les lignes masquées apparaissent

5. le "+" est modifié en "-"

6. lorsque l'on clique sur "-", les lignes sont à nouveau masquées et le "-" devient "+",


Merci à tous de votre aide et de vos idées,
Bonne journée !

 

[JCGL]

Re : Problème insoluble ??

Bonjour à tous,

Peux-tu essayer avec ceci dans un module standard :

Option Explicit


Sub Test()
    Dim Plage As Range
    Dim Lig&
    On Error Resume Next
    Set Plage = Range("A11:F" & Cells(Rows.Count, 1).End(xlUp).Row)
    ActiveSheet.ListObjects.Add(xlSrcRange, Plage, , xlYes).Name = "Tableau1"
    With ActiveWorkbook.Worksheets("Feuil1").ListObjects("Tableau1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("Tableau1[N° produit]")
        .SortFields.Add Key:=Range("Tableau1[Date]"), Order:=xlDescending
        .Header = xlYes
        .Apply
    End With
    
     Cells.Rows.Ungroup
    For Lig = Range("A" & Rows.Count).End(xlUp).Row To 11 Step -1
    If Cells(Lig, 1) = Cells(Lig - 1, 1) Then Rows(Lig).Rows.Group
    Next Lig
    ActiveSheet.Outline.ShowLevels RowLevels:=1
End Sub

A+ à tous

 

[alias_2003]

Re : Problème insoluble ??

Bonjour JCGL,
MERCI !! C'est exactement ce que je recherchais !
J'ai malgré tout un problème lorsque j'ajoute une sortie ou une entrée de mon stock, la ligne n'est pas intégrée au tableau1...
Est-ce que j'ai mal fait quelque chose ?
Bonne journée !

 

[JCGL]

Re : Problème insoluble ??

Bonjour à tous,

As-tu essayé de relancer la macro ?

Je viens de tester et cela à l'air de fonctionner.

A+ à tous

 

[mapomme]

Re : Problème insoluble ??

Bonjour alias_2003, salut JCGL,

Une autre version plus tarasbicotée.

• En cliquant sur un plus, on développe le groupe.
• En cliquant sur un moins, on replie le groupe.
• en cliquant sur +/-, on développe tout.

La colonne A se met a jour (suppression de ligne du tableau, ajout de ligne dans le tableau, modification des données) quand on sélectionne une cellule de la colonne A du tableau

edit: v1.2

 

[alias_2003]

Re : Problème insoluble ??

Bonjour JCGL, mapomme, le forum,
Merci beaucoup mapomme ! Très intéressantes approches ! Grâce à vous 2, j'ai 2 solutions qui me satisfont totalement !!
J'abuse et j'aurais une dernière question...
J'aurais aimé que la dernière saisie ([A:F]) clignote pendant quelques secondes (le "plan" crée lors du classement devant être développé). Ma difficulté est que je ne sais pas comment retrouver la dernière saisie après que la réorganisation du tableau ait été faite...
Une idée ??
Merci beaucoup,
Bonne journée !

 

[alias_2003]

Re : Problème insoluble ??

Bonjour JCGL, le forum,
Je reviens sur ce sujet pour une autre question : la macro que tu m'as gentiment proposée est très bien (!), mais j'aimerais savoir s'il est possible de l'adapter pour plusieurs feuilles contenant le même tableau que celui de la Feuil1 ?
Le nom du tableau "tableau1" n'est plus le même si je copie la feuille 1 par ex., il devient "Tableau13" et la macro n'est plus efficace...
Merci beaucoup !
Bonne journée

 

[JCGL]

Re : Problème insoluble ??

Bonjour à tous,

Tu peux appeler le tableau de chaque feuille Tableau1 ainsi la même macro fonctionnera pour chaque feuille si tu as pris soin de ne pas nommer la feuille mais de mettre ActiveSheet dans le bout de code.

With ActiveWorkbook.ActiveSheet.ListObjects("Tableau1").Sort

Option Explicit


Sub Test()
    Dim Plage As Range
    Dim Lig&
    Application.ScreenUpdating = False
    On Error Resume Next
    Set Plage = Range("A11:F" & Cells(Rows.Count, 1).End(xlUp).Row + 1)
    ActiveSheet.ListObjects.Add(xlSrcRange, Plage, , xlYes).Name = "Tableau1"
    With ActiveWorkbook.ActiveSheet.ListObjects("Tableau1").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("Tableau1[N° produit]")
        .SortFields.Add Key:=Range("Tableau1[Date]"), Order:=xlDescending
        .Header = xlYes
        .Apply
    End With


    Cells.Rows.Ungroup
    Range("Tableau1[#All]").EntireRow.Hidden = False
    For Lig = Range("A" & Rows.Count).End(xlUp).Row To 11 Step -1
        If Cells(Lig, 1) = Cells(Lig - 1, 1) Then Rows(Lig).Rows.Group
    Next Lig
    ActiveSheet.Outline.ShowLevels RowLevels:=1
    Application.ScreenUpdating = True
End Sub

A+ à tous