Autres Affichage par niveau ( 03 niveaux°

chaelie2015

XLDnaute Accro
Bonjour FORUM
Je souhaite faire des affichages par niveau et selon des valeurs des cellules dédiées.
dans le fichier test , j'ai 03 niveaux et 10 Tableaux
Niveau 1 : Nombre de titre principal
Niveau 2 : Nombre des ITEMs
Niveau 3 : Nombre des sous ITEMs
Par exemple :
NIVEAU 1
si je saisi dans "Nombre de Titre Principal" ( cellule BA2) = 3
donc j'aurai en premier affichage que les lignes 4 ,119 et 234 et toutes les autres lignes sont masqués.

NIVEAU 2
Apres si je saisi dans "Nombre des ITEMs" pour chaque lignes affiché
ligne 4 (cellule BA4) = 5 donc j'aurai les lignes 7,18,29,40 et 51 et la ligne 117 (total)
ligne 119 (cellule BA119) = 3 donc j'aurai les lignes 112,133 et 114 et la ligne 232 (total)
ligne 234 (cellule BA234) =4 donc j'aurai les lignes 237,248 ,259 et 270 et la ligne 347 (total)


NIVEAU 3
EN FIN si je saisi dans chaque cellule de "Nombre des sous ITEM" des valeur pour afficher des lignes selon les valeurs des cellules

ci rattaché le fichier test. J'espère que j'était claireo_O
Merci par avance
 

Pièces jointes

  • CHARLIE Bilan 2021.xlsm
    347.5 KB · Affichages: 10
Solution
Nota : quand on modifie BA2 il faut au besoin revalider les autres valeurs en colonne BA.
Cela peut se faire automatiquement en ajoutant en fin de macro :
VB:
'---mise à jour en dessous---
For i = Target.Row + 1 To UsedRange.Row + UsedRange.Rows.Count
     If Cells(i, "AS") <> "" Then If Not Rows(i).Hidden Then Worksheet_Change Cells(i, "BA"): Exit For
Next
Cela prend évidemment plus de temps, voyez ce fichier (2).

herve62

XLDnaute Barbatruc
Supporter XLD
Bonjour
Si j'ai bien compris , tu ne veux que masquer des lignes ?
Donc juste un bout de code comme ça à dupliquer en ajoutant des variables ( pour tes paramètres de choix)
puis mettre dans une boucle ou un select case ( plus long mais plus simple à écrire)
Ci joint un tout début juste pour les cas 1 ou 2 en BA2( juste entrer et valider) cela va masquer
AFFICHER : remet l'affichage complet
recopier à la suite pour le reste des cas
Idem pour les items
On peut faire un select case pour les niveaux en retenant l'adresse de la case changée
Code:
pour récuperer adresse
Adresse = ActiveCell.Address

'pour récuperer numéro de ligne et colonne
Ligne = ActiveCell.Row
Colonne = ActiveCell.Column
Te sens tu capable ?
Ceci n'est qu'un exemple , il y a certainement d'autres méthodes
 

Pièces jointes

  • CHARLIE Bilan 2021H.xlsm
    374.1 KB · Affichages: 5
Dernière édition:

chaelie2015

XLDnaute Accro
Bonjour herve62
Merci pour la réponse j'ai essayé de tester code comme il est , sauf j'ai constaté ce qui suit :
pour la cellule BA2 si je saisi 2 pour la premier fois ça fonctionne ensuite je retape "1" ça fonctionne ensuite si je change encore une fois par 2 , il ne s'affiche pas les deux lignes ?
merci
 
Dernière édition:

herve62

XLDnaute Barbatruc
Supporter XLD
Bin oui , car les lignes sont masquées donc si l'on veut refaire un autre choix impossible pour excel de le deviner car il faut re afficher et le vba ne connait pas les choix précédents, la SUb faire du Hide et ne pas faire en même temps afficher ....c'est incohérent et déjà j'ai dû ajouter un "event=false" pour effacer BA2 sinon ça boucle
et aussi raison du bouton AFFICHER
C'est peut être pas impossible ....mais du code à écrire jusqu'à ????
là de mon côté je suis allé un peu plus loin dans les items ....... c'est TRES long en code !! il faut déjà ajouter des "flags" conditionnels genre exemple : If xxxxx then x=x+1 ; puis IF x=1 then ..... , if x=2 then ..etc jusque 10 et par tableau ........reste les sous items !!!!!! on va bien arriver à 2000 lignes
Bon courage
 

chaelie2015

XLDnaute Accro
Bin oui , car les lignes sont masquées donc si l'on veut refaire un autre choix impossible pour excel de le deviner car il faut re afficher et le vba ne connait pas les choix précédents, la SUb faire du Hide et ne pas faire en même temps afficher ....c'est incohérent et déjà j'ai dû ajouter un "event=false" pour effacer BA2 sinon ça boucle
et aussi raison du bouton AFFICHER
C'est peut être pas impossible ....mais du code à écrire jusqu'à ????
là de mon côté je suis allé un peu plus loin dans les items ....... c'est TRES long en code !! il faut déjà ajouter des "flags" conditionnels genre exemple : If xxxxx then x=x+1 ; puis IF x=1 then ..... , if x=2 then ..etc jusque 10 et par tableau ........reste les sous items !!!!!! on va bien arriver à 2000 lignes
Bon courage
Re
merci pour ces détails ,donc si j'ai bien saisi il n' y a l'actualisation!!! je vais faire le nécessaire.
a+
 

chaelie2015

XLDnaute Accro
??
Le plus simple est de faire un choix ... de se servir du résultat , puis la RAZ ( afficher) ...etc
Car je pense que le but n'est pas de faire joujou avec les choix ?
Re
j'ai adapté le fichier a ton code par qlq modification pour actualiser les lignes.
pour le 1er NIVEAU mnt ça fonctionne, il reste comment intégrer le 2eme niveau dans ce code?
a+
 

Pièces jointes

  • CHARLIE Bilan 2021 H C.xlsm
    356.2 KB · Affichages: 2
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour chaelie2015, herve62, le forum,

Voyez le fichier joint et cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim n&, x$, i&, nn&
Set Target = Intersect(Target, [BA:BA], UsedRange)
If Target Is Nothing Then Exit Sub
If Target.Count > 1 Or Target(1).EntireRow.Hidden Then
    Application.EnableEvents = False 'désactive les évènements
    Application.Undo
    Application.EnableEvents = True 'réactive les évènements
    Exit Sub
End If
Target.Select
n = Abs(Int(Val(Target)))
x = Application.Trim(LCase(Cells(Target.Row, "AS"))) 'SUPPRESPACE
Application.ScreenUpdating = False
If x Like "*principal*" Then
    i = Application.Match(Application.Max([A:A]), [A:A], 0)
    i = i + Application.Match("S/TOTAL*", Cells(i + 1, 1).Resize(10000), 0)
    Rows(Target.Row + 2 & ":" & i).Hidden = True 'masque
    If n Then
        i = Application.Match(Application.Min(n, Application.Max([A:A])), [A:A], 0)
        i = i + Application.Match("S/TOTAL*", Cells(i + 1, 1).Resize(10000), 0)
        Rows(Target.Row & ":" & i).Hidden = False 'affiche
    End If
ElseIf x Like "*des item*" Then
    i = Target.Row + Application.Match("S/TOTAL*", Cells(Target.Row + 1, 1).Resize(10000), 0)
    Rows(Target.Row + 3 & ":" & i - 1).Hidden = True 'masque
    If n Then
        x = "*sous item*"
        For i = Target.Row + 1 To 10000
            If LCase(Cells(i, "AS")) Like x Then nn = nn + 1
            If nn = n + 1 Or UCase(Cells(i, 1)) Like "S/TOTAL*" Then Exit For
        Next
        Rows(Target.Row & ":" & i - 1).Hidden = False 'affiche
    End If
ElseIf x Like "*sous item*" Then
    x = "*sous item*"
    For i = Target.Row + 1 To 10000
        If LCase(Cells(i, "AS")) Like x Or UCase(Cells(i, 1)) Like "S/TOTAL*" Then Exit For
    Next
    With Rows(Target.Row + 1 & ":" & i - 1)
        .Hidden = True 'masque
        If n Then .Resize(IIf(n > .Rows.Count, .Rows.Count, n)).Hidden = False 'affiche
    End With
End If
Application.ScreenUpdating = True
End Sub
Elle se déclenche quand on modifie les valeurs en colonne BA.

Nota : quand on modifie BA2 il faut au besoin revalider les autres valeurs en colonne BA.

A+
 

Pièces jointes

  • CHARLIE Bilan 2021(1).xlsm
    356.4 KB · Affichages: 3
Dernière édition:

chaelie2015

XLDnaute Accro
Bonjour chaelie2015, herve62, le forum,

Voyez le fichier joint et cette macro dans le code de la feuille :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim n&, x$, i&, nn&
Set Target = Intersect(Target, [BA:BA], UsedRange)
If Target Is Nothing Then Exit Sub
If Target.Count > 1 Or Target(1).EntireRow.Hidden Then
    Application.EnableEvents = False 'désactive les évènements
    Application.Undo
    Application.EnableEvents = True 'réactive les évènements
    Exit Sub
End If
Target.Select
n = Abs(Int(Val(Target)))
x = Application.Trim(LCase(Cells(Target.Row, "AS"))) 'SUPPRESPACE
Application.ScreenUpdating = False
If x Like "*principal*" Then
    i = Application.Match(Application.Max([A:A]), [A:A], 0)
    i = i + Application.Match("S/TOTAL*", Cells(i + 1, 1).Resize(10000), 0)
    Rows(Target.Row + 2 & ":" & i).Hidden = True 'masque
    If n Then
        i = Application.Match(Application.Min(n, Application.Max([A:A])), [A:A], 0)
        i = i + Application.Match("S/TOTAL*", Cells(i + 1, 1).Resize(10000), 0)
        Rows(Target.Row & ":" & i).Hidden = False 'affiche
    End If
ElseIf x Like "*des item*" Then
    i = Target.Row + Application.Match("S/TOTAL*", Cells(Target.Row + 1, 1).Resize(10000), 0)
    Rows(Target.Row + 3 & ":" & i - 1).Hidden = True 'masque
    If n Then
        x = "*sous item*"
        For i = Target.Row + 1 To 10000
            If LCase(Cells(i, "AS")) Like x Then nn = nn + 1
            If nn = n + 1 Or UCase(Cells(i, 1)) Like "S/TOTAL*" Then Exit For
        Next
        Rows(Target.Row & ":" & i - 1).Hidden = False 'affiche
    End If
ElseIf x Like "*sous item*" Then
    x = "*sous item*"
    For i = Target.Row + 1 To 10000
        If LCase(Cells(i, "AS")) Like x Or UCase(Cells(i, 1)) Like "S/TOTAL*" Then Exit For
    Next
    With Rows(Target.Row + 1 & ":" & i - 1)
        .Hidden = True 'masque
        If n Then .Resize(IIf(n > .Rows.Count, .Rows.Count, n)).Hidden = False 'affiche
    End With
End If
Application.ScreenUpdating = True
End Sub
Elle se déclenche quand on modifie les valeurs en colonne BA.

Nota : quand on modifie BA2 il faut au besoin revalider les autres valeurs en colonne BA.

A+
Bonjour JOB75, herve62, le forum,
Merci pour la réponse super, donc il y a pas une possibilité de faire actualisation automatique.
on vas voir par des boutons ????
a+
 
Dernière édition:

job75

XLDnaute Barbatruc
Nota : quand on modifie BA2 il faut au besoin revalider les autres valeurs en colonne BA.
Cela peut se faire automatiquement en ajoutant en fin de macro :
VB:
'---mise à jour en dessous---
For i = Target.Row + 1 To UsedRange.Row + UsedRange.Rows.Count
     If Cells(i, "AS") <> "" Then If Not Rows(i).Hidden Then Worksheet_Change Cells(i, "BA"): Exit For
Next
Cela prend évidemment plus de temps, voyez ce fichier (2).
 

Pièces jointes

  • CHARLIE Bilan 2021(2).xlsm
    357.7 KB · Affichages: 3

chaelie2015

XLDnaute Accro
Re Bonjour JOB , Forum
j'ai ajouter dans un module un code pour effacer les cellules de niveau 2

VB:
Sub Effacer_nbre_ITEM()
[BA2].Select

If MsgBox("Voulez-vous effacer toutes les données...?", vbYesNo, "EFFACER") = vbYes Then
Range("BA4,BA119,BA234,BA349,BA464,BA597,BA694,BA809,BA924,BA1039") = ""
End If

End Sub
Le débogage m'affiche un problème sur cette partie de la macro:
"Application.Undo"
Erreur d'exécution 1004
la méthode 'Undo' de l'objet application à échoué
MERCI
 
Dernière édition:

chaelie2015

XLDnaute Accro
Re JOB
j'ai utilisé ce code
VB:
Sub Effacer_nbre_ITEM()

Application.EnableEvents = False 'désactive les évènements

If MsgBox("Voulez-vous effacer toutes les données...?", vbYesNo, "EFFACER") = vbYes Then
Range("BA4:BA4,BA119:BA119,BA234:BA234,BA349:BA349,BA464:BA464,BA579:BA579,BA694:BA694,BA809:BA809,BA924:BA924,BA1039:BA1039").ClearContents
End If

Application.EnableEvents = True 'réactive les évènements
Range("BA4").Select
ActiveCell.FormulaR1C1 = ""
End Sub
est ça fonctionné mais je ne suis pas sure?
A+
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 909
Membres
101 836
dernier inscrit
karmon