Discussion :

[Almenor]

Bonjour à tous,

J'ai un tableau reprenant des projets avec une date de début et une date de fin, et sur une autre feuille un graphique sur deux semaines reprenant les info de ce tableau.

J'aimerai que si un projet n’apparaît pas dans les deux semaines choisies la ligne en question soit masquée.

Merci !

[Menhir]

Pas besoin de VBA pour ça. Place un filtre sur tes données.
Tu sélectionnes tes données > Ruban Données > Icone Filtrer

Des boutons avec un flèche vers le bas apparaissent dans les entêtes.
Tu cliques sur celui concernant tes dates et tu fixes tes bornes.
Les lignes qui seront hors critères seront masquées et n'apparaitront plus dans tes graphiques.

[Almenor]

Bonjour Menhir,

Merci pour ta réponse, mais j'aimerais vraiment que ce soit automatisé. Le principe étant que les utilisateurs remplissent uniquement le tableau et ne touchent pas à l'onglet avec le graphique.

En gros j'aimerai que chaque ligne soit testée et si le projet n'est pas dans la fourchette des deux semaines affichées ça masque la ligne.

Ça ne risque pas de devenir trop lourd quand il y aura trop de projets ? Un autre moyen que ligne par ligne ?

[Almenor]

Voici ce que j'ai fais jusqu'ici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Worksheet_Calculate()
    Dim plage As Range, c As Range, i As Integer
    i = 5
    Set plage = Range("A10:A15")
    For Each c In plage
        If (Range("B5").Value <= Sheets("Tableau").Range("C" & i).Value And Range("AC5").Value >= Sheets("Tableau").Range("C" & i).Value) Or (Range("B5").Value <= Sheets("Tableau").Range("D" & i).Value And Range("AC5").Value >= Sheets("Tableau").Range("D" & i).Value) Then
            'MsgBox Range("B5").Value & " " & Sheets("Tableau").Range("C" & i).Value
            c.EntireRow.Hidden = False
        Else
            c.EntireRow.Hidden = True
        End If
        i = i + 1
    Next c
    Set plage = Nothing
End Sub

J'ai un message d'erreur sur c.EntireRow.Hidden = True

Pour le reste ça à l'air de faire exactement ce que je demande la petite message box est là pour ça. Pour l'instant je fais ça sur 6 ligne (A10 -> A15) mais normalement ce code s'effectuera sur 200 lignes.. d'où ma question précédente sur la lourdeur du truc...

[Menhir]

j'aimerais vraiment que ce soit automatisé.

Il suffit de faire la même chose que ce que j'explique ci-dessus avec une instruction VBA.
L'enregistreur automatique de macro pourra te fournir 80% du code.
L'aide VBA en ligne t'aidera à trouver les 20% restant.

Ça ne risque pas de devenir trop lourd quand il y aura trop de projets ?

Avec ta méthode, vraisemblablement (les boucles For sont affreusement lentes pour des macro évènementielles).
Avec ma méthode, ce sera sans doute plus rapide.

Private Sub Worksheet_Calculate()

Il serait plus sûr d'utiliser Worksheet_Change, en commençant par vérifier si la zone modifiée est bien celle où tu entres les dates "bornes" pour éviter d'exécuter le reste si ce n'est pas le cas.
https://msdn.microsoft.com/fr-fr/lib.../ff839775.aspx

[Almenor]

Le soucis avec Worksheet_Change est que comme on navigue dans le calendrier via une barre de défilement il ne repère pas les changement sur la cellule liée.

J'ai lié la barre de défilement à la cellule B1, le contenu change donc quand on fait défiler la barre de défilement mais Worksheet_Change ne détecte pas ce changement alors que si je change la valeur de la cellule B1 manuellement là pas de soucis.

C'est pour cela que je passe par calculate mais effectivement ça s'active au moindre changement :s

[Almenor]

J'ai un peu améliorer le code pour éviter toute actions inutile.

Désormais il fera les différents tests uniquement sur le mouvement de la barre de défilement. En gros quand je lance excel il stock la position actuelle de la barre de défilement et il ne rentrera dans le code uniquement sur une valeur différente.

Toujours dans un soucis d'économiser les ressources il ne testera pas sur les 200 lignes comme j'avais prévu au départ mais jusqu'à la dernière ligne non vide.

Voici la dernière version de mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 
Private Sub Worksheet_Calculate()
    If ThisWorkbook.scrollnumber <> Range("B1").Value Then
        MsgBox "on rentre dans le calculate !"
        Dim plage As Range, c As Range, i As Integer
        i = 5
        Set plage = Range("A10:A200")
        For Each c In plage
            If c <> "" Then
                If (Range("B5").Value <= Sheets("Tableau").Range("C" & i).Value And Range("AC5").Value >= Sheets("Tableau").Range("C" & i).Value) Or (Range("B5").Value <= Sheets("Tableau").Range("D" & i).Value And Range("AC5").Value >= Sheets("Tableau").Range("D" & i).Value) Then
                    MsgBox c & " a un projet"
                    'c.EntireRow.Hidden = False
                Else
                    MsgBox c & " n'a pas de projet !"
                    'c.EntireRow.Hidden = True
                End If
            End If
            i = i + 1
        Next c
        Set plage = Nothing
        ThisWorkbook.scrollnumber = Range("B1").Value
    End If
End Sub

Il ne me reste plus qu'à savoir comment cacher la ligne puisque c.EntireRow.Hidden = True n'a pas l'air de fonctionner :s

[Almenor]

Bonjour,

J'ai finalement quelque chose qui fonctionne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
 
Private Sub Worksheet_Calculate()
    If ThisWorkbook.scrollnumber <> Range("B1").Value Then
        'MsgBox "on rentre dans le calculate !"
        ThisWorkbook.scrollnumber = Range("B1").Value
        Dim plage As Range, c As Range, i As Integer, row As Integer
        i = 5
        row = 10
        Set plage = Range("A10:A200")
        For Each c In plage
            If c <> "" Then
                If (Range("B5").Value <= Sheets("Tableau").Range("C" & i).Value And Range("AC5").Value >= Sheets("Tableau").Range("C" & i).Value) Or (Range("B5").Value <= Sheets("Tableau").Range("D" & i).Value And Range("AC5").Value >= Sheets("Tableau").Range("D" & i).Value) Then
                    'MsgBox c & " a un projet"
                    Rows(row & ":" & row).Select
                    Selection.EntireRow.Hidden = False
                    Range("A" & row).Select
                Else
                    'MsgBox c & " n'a pas de projet !"
                    Rows(row & ":" & row).Select
                    Selection.EntireRow.Hidden = True
                    Range("A" & row).Select
                End If
            End If
            i = i + 1
            row = row + 1
        Next c
        Set plage = Nothing
    End If
End Sub

Pas sûr que ce soit très optimal, à voir comment cela ce comportera quand il y aura plusieurs 10aine de projets...