Sujet Précédent Sujet Suivant

Atteindre une valeur et developper les lignes c

pierklaud Messages postés 8 Date d'inscription lundi 21 mai 2018 Statut Membre Dernière intervention 24 mai 2018 - 21 mai 2018 à 08:42
pierklaud Messages postés 8 Date d'inscription lundi 21 mai 2018 Statut Membre Dernière intervention 24 mai 2018 - 24 mai 2018 à 21:13
Bonjour,
Dans mon classeur Excel, je cherche à créer une liste de boutons (une barre d'outils personnalisée ?) qui me permettrait d'atteindre et de me positionner sur une valeur cible
Tableau exemple : https://www.cjoint.com/c/HEvgGnuQ7V5
Dans ce tableau en cliquant sur le bouton "1" j'aimerais atteindre la 1ère cellule correspondante à la "Region 1" (cellule A4) et une fois que je suis positionné sur cette cellule faire dégrouper toutes les lignes correspondantes pour cette "Region" (Ligne 5 à 24).
Est-ce possible.
Merci pour votre aide.

5 réponses

Réponse 1 / 5
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 22
22 mai 2018 à 19:53
Bonjour,

Une façon de faire si tu n'as pas plus de 9 boutons
Autrement il faudrait utiliser une autre méthode pour trouver la valeur à afficher.

Et si tu n'avais pas de sous-totaux, un simple filtre suffirait 


    Dim I As Long, nbLignes As Long
    Dim Debut As Long, Fin As Long
    Dim Bouton
    Dim Valeur As Integer
    
    nbLignes = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    
    Bouton = Application.Caller
    Valeur = Val(Right(Bouton, 1))
    
    For I = 4 To nbLignes
        If Rows(I).Hidden = False And Range("A" & I) = Valeur Then
            Debut = I
            Exit For
        End If
    Next
    For I = Debut + 1 To nbLignes
        If Rows(I).Hidden = False And Range("A" & I) <> Valeur Then
            Fin = I
            Exit For
        End If
    Next
    
    If Debut > 0 And Fin > 0 Then
        Range("A" & Debut & ":A" & Fin).EntireRow.Hidden = False
    End If
0
pierklaud Messages postés 8 Date d'inscription lundi 21 mai 2018 Statut Membre Dernière intervention 24 mai 2018
22 mai 2018 à 23:18
Bonjour,

Il y aura une cinquantaine de boutons (50 sites). Donc il semble que la méthode que tu proposes ne pourra pas être utilisée.

Par ailleurs, je ne comprends ce que tu veux dire par "Et si tu n'avais pas de sous-totaux, un simple filtre suffirait"

Merci pour ta réponse et pour ton aide.
0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 21 > pierklaud Messages postés 8 Date d'inscription lundi 21 mai 2018 Statut Membre Dernière intervention 24 mai 2018
23 mai 2018 à 10:26
Avec un simple filtre :
https://mon-partage.fr/f/NIWcJuIY/
0
pierklaud Messages postés 8 Date d'inscription lundi 21 mai 2018 Statut Membre Dernière intervention 24 mai 2018 > Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023
23 mai 2018 à 12:19
Merci pour ta proposition Patrice qui semble efficace... dès lors que l'utilisateur du fichier est capable d'utiliser un filtre !!!...
Malheureusement je dois m'adapter aux utilisateurs qui, bien souvent, sont incapables de faire autre chose que de cliquer sur un bouton ! ... D'où mon idée de départ de proposer un bouton à cliquer pour afficher le site choisi par l'utilisateur.
0
Réponse 2 / 5
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 22
23 mai 2018 à 14:54
Une autre méthode 
Sub Afficher()
    Dim I As Long, nbLignes As Long
    Dim Debut As Long, Fin As Long
    Dim Bouton
    Dim Valeur As Integer
    Dim Tablo
    
    nbLignes = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    
    Bouton = Application.Caller
    Tablo = Split(Bouton, " ")
    Valeur = Tablo(1)
    
    For I = 4 To nbLignes
        If Rows(I).Hidden = False And Range("A" & I) = Valeur Then
            Debut = I
            Exit For
        End If
    Next
    For I = Debut + 1 To nbLignes
        If Rows(I).Hidden = False And Range("A" & I) <> Valeur Then
            Fin = I
            Exit For
        End If
    Next
    
    If Debut > 0 And Fin > 0 Then
        Range("A" & Debut & ":A" & Fin).EntireRow.Hidden = False
    End If
End Sub
0
pierklaud Messages postés 8 Date d'inscription lundi 21 mai 2018 Statut Membre Dernière intervention 24 mai 2018
23 mai 2018 à 22:20
J'ai essayé d'adapter cette nouvelle méthode mon classeur.
Cela fonctionne pour les 3 premiers boutons mais pas pour les autres... et je ne comprends pas pourquoi ?
https://www.cjoint.com/c/HExuts1pzr5

Merci encore pour ton aide.
0
Réponse 3 / 5
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 21
24 mai 2018 à 14:14
Bonjour,

Une autre proposition avec macro mais sans bouton :
https://mon-partage.fr/f/HRiMIbcB/
0
pierklaud Messages postés 8 Date d'inscription lundi 21 mai 2018 Statut Membre Dernière intervention 24 mai 2018
24 mai 2018 à 14:28
Merci Patrice.
Désolé il y a un problème à l'ouverture avec ton fichier...
0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 21
24 mai 2018 à 15:45
Peux-tu préciser quel problème ?
0
pierklaud Messages postés 8 Date d'inscription lundi 21 mai 2018 Statut Membre Dernière intervention 24 mai 2018 > Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023
24 mai 2018 à 21:13
J'ai un message d'erreur à l'ouverture après avoir cliqué sur "Activer les macros"


Puis quand je clique sur "Oui
"

Enfin quand je clique dans une cellule il ne se passe rien.

Merci pour ton aide.
0
Réponse 4 / 5
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 22
Modifié le 24 mai 2018 à 15:04
Une autre méthode sans bouton. Plus simple selon moi.
Tu mets une liste déroulante de choix en A1 et tu lui donnes les valeurs nécessaires (1 à X)
Et tu interceptes le changement de cette cellule.

Code à mettre dans la feuille 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim I As Long, nbLignes As Long
    Dim Debut As Long, Fin As Long
    Dim Valeur As Integer
    
    If Target.Address(False, False) = "A1" Then
    
        nbLignes = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
        
        Valeur = Target.Value
        
        For I = 4 To nbLignes
            If Rows(I).Hidden = False And Range("A" & I) = Valeur Then
                Debut = I
                Exit For
            End If
        Next
        For I = Debut + 1 To nbLignes
            If Rows(I).Hidden = False And Range("A" & I) <> Valeur Then
                Fin = I
                Exit For
            End If
        Next
        
        If Debut > 0 And Fin > 0 Then
            Range("A" & Debut & ":A" & Fin).EntireRow.Hidden = False
        End If
    End If
End Sub


NB: je n'ouvre pas les fichiers avec macros...

0
pierklaud Messages postés 8 Date d'inscription lundi 21 mai 2018 Statut Membre Dernière intervention 24 mai 2018
24 mai 2018 à 16:19
Ok je retiens ta proposition plus simple de passer par une liste de choix. C'est pas plus difficile pour l'utilisateur final que de cliquer sur un bouton...
J'ai intégré ton code à mon classeur. Cela fonctionne.

Maintenant, si je peux me permettre, est-ce que ce serait envisageable de faire en sorte que lorsque je fais un nouveau choix dans la liste déroulante, les lignes du choix précédent se regroupent (puisqu'elles ont été dégroupées) et que SEULES les lignes du nouveau choix s'affichent.
En fait, à chaque fois que je fais un choix dans la liste déroulante j'aimerai que les lignes soient regroupées et que seules les lignes de la valeur choisie dans la liste déroulante soient dégroupées.

Merci beaucoup.
0
Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 21 > pierklaud Messages postés 8 Date d'inscription lundi 21 mai 2018 Statut Membre Dernière intervention 24 mai 2018
Modifié le 24 mai 2018 à 17:38
C'est exactement ce que fait le code du dernier fichier que je t'avais proposé, sans bouton et sans liste choix, il suffit de sélectionner une cellule dans la region : 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim n°L As Long
Dim p°L As Long
Dim d°L As Long
Dim reg As Integer
Dim aff As Boolean

  n°L = Cells(4, "A").Row
' EDIT : remplacer la ligne suivant :  
' d°L = Cells(Rows.Count, "C").End(xlUp).Row
' Par celle ci :
  d°L = Columns(3).Find("*", , , , , xlPrevious).Row
  If Target.Row < n°L Or Target.Row > d°L Then Exit Sub
  reg = Val(Cells(Target.Row, "A").Value)
  If reg = 0 Then Exit Sub
  Application.ScreenUpdating = False
  Do While n°L <= d°L
    If Val(Cells(n°L, "A").Value) <> 0 Then
      aff = reg <> Val(Cells(n°L, "A").Value)
      Rows(n°L).Hidden = False
    Else
      Rows(n°L).Hidden = aff
    End If
    n°L = n°L + 1
  Loop
  Application.ScreenUpdating = True

End Sub
0
pierklaud Messages postés 8 Date d'inscription lundi 21 mai 2018 Statut Membre Dernière intervention 24 mai 2018 > Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023
24 mai 2018 à 21:04
Merci Patrice.
Comme je l'ai indiqué dans un message précédent je ne suis pas parvenu à ouvrir ton fichier.
Avec le code que tu me donnes ça fonctionne bien et effectivement le groupement et dégroupement des lignes correspond à ce que je recherchais.
Par contre, le fait d'utiliser une liste déroulante est plus adaptée pour "naviguer" dans la liste des nombreux sites.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 5
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 22
24 mai 2018 à 19:50
Pour masquer les autres sélections, il suffit d'ajouter cette ligne à mon code.
Si c'est celui que tu veux utiliser, ben sûr.
<code>
......................
If Target.Address(False, False) = "A1" Then

ActiveSheet.Outline.ShowLevels RowLevels:=1 '<<<<
........................../code>

0

Discussions similaires

Valeur absolue
hred1 -
Nikoui -

1 réponse
création d'une Application Android
EmmanuelNtumba -
NHenry -

6 réponses
Valeur absolue d'un chiffre
z980x -
z980x -

2 réponses
valeur absolue
hela_bouks -
avatar11 -

1 réponse
Langage C, Valeur absolu, fabs
Valerian13 -
SAKingdom -

8 réponses
valeur abslue
didi59650 -
neko -

6 réponses
Rejoignez-nous