XL 2016 Masquer des colonnes en fonction d'une liste déroulante

Ricket77

XLDnaute Nouveau
Bonjour tout le monde,

Je suis en train de bucher sur un problème de mise en page d'une feuille excel :

Lorsque l'on sélectionne dans la liste déroulante, un mois, j'aimerais que les colonnes, avant le 1er jour du mois sélectionné, soient masquées. (Dans l'exemple colonne B-DM), avec une 2ème contrainte, que l'affichage commence la semaine le lundi 28.02.2022 et non le mardi 01.03.2022.

Je suppose qu'il faut le faire en VBA, est-ce que quelqu'un peu m'aider.

En annexe le fichier d'exemple.

Merci Pour votre retour.

Ricket
 

Pièces jointes

  • Base.xlsx
    38.8 KB · Affichages: 9

Robert

XLDnaute Barbatruc
Repose en paix
Bonsoir Ricket et bienvenu, bonsoir le forum,

En pièce jointe ton fichier modifié avec l'événementielle Change ci-dessous :

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TD As Variant 'déclare la variable TD (Tableau des Dates)
Dim CD As Integer 'déclare la variable CD (Colonne du Début)
Dim I As Integer 'déclare la variable I (Incrément)

Me.Columns.Hidden = False 'affiche toutes les colonnes
TD = Range(Cells(6, "A"), Cells(6, Application.Columns.Count).End(xlToLeft)) 'définit le tableau des dates TD
If Range("A1").Value = "Janvier" Then Exit Sub 'si A1 vaut "Janvier", sort de la procédure
For I = 2 To UBound(TD, 2) 'boucle sur toutes les colonnes I de TD (en partant de la seconde)
    'condition si la date ligne 1 colonne I de TD est égale au premier du mois de A1 de l'année 2022
    If CDate(TD(1, I)) = CDate("1/" & Range("A1").Value & "/2022") Then
        CD = I 'définit la colonne de début TD
        Exit For 'sort de la boucle
    End If 'fin de la condition
Next I 'prochaine colonne de la boucle
If Weekday(Cells(6, CD), vbMonday) <> 1 Then 'condition : si le jour de la semaine de la cellule ligne 6 colonne CD est différent de Lundi
    Do 'exécute
        CD = CD - 2 'redéfinit la colonne du début CD
    Loop Until Weekday(Cells(6, CD), vbMonday) = 1 'boucle tant que le jour de la semaine de la cellue ligne 6 colonne CD ne vaut pas 1
End If 'fin de la condition
Range(Cells(1, 2), Cells(1, CD - 1)).EntireColumn.Hidden = True 'masque les colonnes de 2 à CD
End Sub
Sélectionne Janvier pour avoir le tableau entier...

Le fichier :
 

Pièces jointes

  • Ricket_ED_V01.xlsm
    49.7 KB · Affichages: 6

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonsoir @Ricket77 :) , @Robert ;),

Un autre code VBA dans le module de la feuille "Feuil1":
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, n&
   If Intersect(Range("a1"), Target) Is Nothing Then Exit Sub
   Rows(1).EntireColumn.Hidden = False
   x = CDate(Join(Array(1, [a1], 2022))): x = x - Weekday(x, 2) + 1
   n = Application.Evaluate("=IFERROR(MATCH(" & (1 * x) & ",6:6,0),0)")
   If n > 0 Then Range(Cells(1, 2), Cells(1, n - 1)).EntireColumn.Hidden = True
End Sub
 

Pièces jointes

  • Ricket77- Base- v1.xlsm
    46.6 KB · Affichages: 7

mapomme

XLDnaute Barbatruc
Supporter XLD
Re à tous,

Je ne peux pas faire moins que @Robert 😜. Robert a commenté son code, je commente donc le mien !
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, n&
   If Intersect(Range("a1"), Target) Is Nothing Then Exit Sub  ' si la cellule A1 n'a pas changé, on ne fait rien
   Rows(1).EntireColumn.Hidden = False    ' on affiche toutes les colonnes
   ' x est la date du premier du mois : puis on retire à x le nombre de jours nécessaires pour avoir le lundi
   x = CDate(Join(Array(1, [a1], 2022))): x = x - Weekday(x, 2) + 1
   ' dans la ligne 6, on recherche le n° de colonne de la date x (si la date est absente, on retourne 0)
   n = Application.Evaluate("=IFERROR(MATCH(" & (1 * x) & ",6:6,0),0)")
   ' si la date existe en colonne n,  on masque les colonnes 2 à (n-1)
   If n > 0 Then Range(Cells(1, 2), Cells(1, n - 1)).EntireColumn.Hidden = True
End Sub
 

Ricket77

XLDnaute Nouveau
Bonsoir Ricket et bienvenu, bonsoir le forum,

En pièce jointe ton fichier modifié avec l'événementielle Change ci-dessous :

VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim TD As Variant 'déclare la variable TD (Tableau des Dates)
Dim CD As Integer 'déclare la variable CD (Colonne du Début)
Dim I As Integer 'déclare la variable I (Incrément)

Me.Columns.Hidden = False 'affiche toutes les colonnes
TD = Range(Cells(6, "A"), Cells(6, Application.Columns.Count).End(xlToLeft)) 'définit le tableau des dates TD
If Range("A1").Value = "Janvier" Then Exit Sub 'si A1 vaut "Janvier", sort de la procédure
For I = 2 To UBound(TD, 2) 'boucle sur toutes les colonnes I de TD (en partant de la seconde)
    'condition si la date ligne 1 colonne I de TD est égale au premier du mois de A1 de l'année 2022
    If CDate(TD(1, I)) = CDate("1/" & Range("A1").Value & "/2022") Then
        CD = I 'définit la colonne de début TD
        Exit For 'sort de la boucle
    End If 'fin de la condition
Next I 'prochaine colonne de la boucle
If Weekday(Cells(6, CD), vbMonday) <> 1 Then 'condition : si le jour de la semaine de la cellule ligne 6 colonne CD est différent de Lundi
    Do 'exécute
        CD = CD - 2 'redéfinit la colonne du début CD
    Loop Until Weekday(Cells(6, CD), vbMonday) = 1 'boucle tant que le jour de la semaine de la cellue ligne 6 colonne CD ne vaut pas 1
End If 'fin de la condition
Range(Cells(1, 2), Cells(1, CD - 1)).EntireColumn.Hidden = True 'masque les colonnes de 2 à CD
End Sub
Sélectionne Janvier pour avoir le tableau entier...

Le fichier :
Merci beaucoup Robert,
c'est exactement cela que je recherche, et merci aussi à Mapomme, 2 exemples concret. Celui a Mapomme me parait plus simple et moins long.
Mais n'étant pas programmeur, mais en ayant quelques bases simple, il me parait moins lourd. j'espère arriver a intégrer cela dans mon fichier définitif qui comprend déjà pas mal de code.
 

Ricket77

XLDnaute Nouveau
Re à tous,

Je ne peux pas faire moins que @Robert 😜. Robert a commenté son code, je commente donc le mien !
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, n&
   If Intersect(Range("a1"), Target) Is Nothing Then Exit Sub  ' si la cellule A1 n'a pas changé, on ne fait rien
   Rows(1).EntireColumn.Hidden = False    ' on affiche toutes les colonnes
   ' x est la date du premier du mois : puis on retire à x le nombre de jours nécessaires pour avoir le lundi
   x = CDate(Join(Array(1, [a1], 2022))): x = x - Weekday(x, 2) + 1
   ' dans la ligne 6, on recherche le n° de colonne de la date x (si la date est absente, on retourne 0)
   n = Application.Evaluate("=IFERROR(MATCH(" & (1 * x) & ",6:6,0),0)")
   ' si la date existe en colonne n,  on masque les colonnes 2 à (n-1)
   If n > 0 Then Range(Cells(1, 2), Cells(1, n - 1)).EntireColumn.Hidden = True
End Sub
Merci pour les commentaires, qui pour un novice ne sont pas toujours facile à suivre.

Merci infiniment.
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Ricket77 :)
Merci pour les commentaires, qui pour un novice ne sont pas toujours facile à suivre.
Bon, mes commentaires sont peu clairs. Je ne me vexe pas, je reste calme, serein et positif en ce dimanche ensoleillé 😄🤣

Je comprends ta remarque. Comme tu sembles intéressé à comprendre et que ce n'est pas souvent le cas, j'ai commenté à nouveau mon code mais en beaucoup plus détaillé.

Ne pas oublier non plus de consulter la DOC VBA, en sélectionnant l'instruction désirée et en tapant F1. L'aide n'est pas si mal faite (un peu moins que dans les versions précédentes car traduite automatiquement et imparfaitement corrigée - AMHA :()

Si tu as des questions, n'hésite pas à me les poser via ce fil ;)
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, n&

   ' Target est l'ensemble des cellules qui ont été modifiées. On cherche si la cellule A1 est parmi ces cellules.
   ' Si ce n'est pas le cas, on quitte la procédure puisque le mois n'a pas changé. Pour cela, on calcule l'intersection
   ' des cellules modifiées (Target) et de la cellule A1. On compare le résultat à l'ensemble vide (Nothing)
 
   If Intersect(Range("a1"), Target) Is Nothing Then Exit Sub  ' si la cellule A1 n'a pas changé, on ne fait rien
 
 
   ' on affiche toutes les colonnes. On considère la ligne 1 - rows(1). On en prend toutes les colonnes
   ' et on affiche toutes ces colonnes
 
   Rows(1).EntireColumn.Hidden = False
 
 
   ' on va constuire une chaine de caractère représentant le premier jour du mois choisi. Pour cela,
   ' on construit un tableau à une dimension contenant les trois éléments (1 , mois choisi , année)
   ' avec l 'instruction Array. Array(1, range("a1"),  2022) qu'on peut aussi écrire Array(1, [a1], 2022).
   ' Ensuite, on utilise l'instruction JOIN qui prend comme argument un tableau T à une dimension et
   ' une chaine de caractères SEP. JOIN(T,SEP) va concatener les éléments du tableau en les séparant
   ' par la chaine SEP. Si SEP est omis, alors le séparateur est par défaut le caractère espace.
   ' donc si Ai contient mars alors JOIN(Array(1, [a1],  2022) va donner la chaine "1 mars 2022"
   ' ça revient à faire : 1 & " " & Range("a1").value & " " & 2022
 
   ' le résultat est ensuite converti de texte en vraie date par CDATE(JOIN(Array(1, [a1],  2022))
   x = CDate(Join(Array(1, [a1], 2022)))
 
 
   ' il faut maintenant trouver le précédent lundi. Pour cela, on utilise Weekday(date,premier jour de la semaine)
   ' qui renvoie un nombre entre 1 et 7 représentant le jour de la semaine
   ' la paramètre premier jour de la semaine est pris égal à 2 qui veut dire que Weekday va considérer
   ' le lundi comme le premier jour de la semaine. Si date est un lundi alors weekday renverra 1,
   ' si date est un mardi alors weekday renverra 2, ..., si date est un dimanche alors weeeday renverra 7
 
   ' si x est un lundi, on doit soustraire 0 jour à x pour avoir le lundi     (weekday(x,2)renvoie 1)
   ' si x est un mardi, on doit soustraire 1 jour à x pour avoir le lundi     (weekday(x,2)renvoie 2)
   ' si x est un mercredi, on doit soustraire 2 jours à x pour avoir le lundi (weekday(x,2)renvoie 3)
   ' ...
   ' si x est un dimanche, on doit soustraire 6 jours à x pour avoir le lundi (weekday(x,2)renvoie 7)
 
   ' On voit donc qu'à partir de la date x du premier du mois, il faut soustraire à x le type de jour moins un
   ' soit x - (Weekday(x, 2) -1) qu'on peut aussi écrire
 
   x = x - Weekday(x, 2) + 1
 
 
   ' dans la ligne 6, on recherche le n° de colonne de la date x (si la date est absente, on retourne 0)
   ' Pour cela, la formule excel sur la feuille de calcul serait : SIERREUR(EQUIV(date du lundi; 6:6; 0), 0)
   '
   ' On va utiliser l'instruction Application.Evaluate(formule-texte) qui va évaluer (calculer)
   ' la formule-texte. Excemple Application.evaluate("11+2") renverra 13
 
   ' Il faut fabriquer l'instruction à évaluer (en anglais bien sûr!) en insérant comme paramètre la date du lundi
   ' soit "=IFERROR(MATCH(" & date-du-lundi & ",6:6,0),0)" qui donnerait =IFERROR(MATCH(date-du-lundi,6:6,0),0)
   ' on écrit donc ="IFERROR(MATCH("   &   x   &   ",6:6,0),0)"
   ' mais cela ne marchera pas car pour des raisons (que je ne développerai pas), il faut transformer la date en nombre.
   ' Pour cela, on multiplie la date x par 1 : (1 * x)
 
   n = Application.Evaluate("=IFERROR(MATCH(" & (1 * x) & ",6:6,0),0)")
 
   ' à ce stade n est soit le numéro de la colonne contenant la date du lundi x soit 0 (date non trouvée)
   ' si la date a été trouvée (x>0), alors on masque les colonnes 2 jusqu'à une colonne
   ' avant la colonne du lundi x soit la jusqu'à la colonne n-1
 
   If n > 0 Then Range(Cells(1, 2), Cells(1, n - 1)).EntireColumn.Hidden = True
End Sub
 

Pièces jointes

  • Ricket77- Base- v1 (commenté).xlsm
    50.7 KB · Affichages: 1
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour Ricket77, Robert, mapomme,

Puisqu'on veut qu'un mois commence le lundi il faut peut-être que l'année 2022 commence le 27/12/2021.

Voyez le fichier joint et cette macro :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dat As Long
Columns.Hidden = False 'affiche toutes les colonnes
On Error Resume Next 'si A1 est vide où si le jour n'existe pas
dat = CDate("1/" & [A1]) - Weekday(CDate("1/" & [A1]), 2) + 1 'lundi précédent le 1er du mois
Columns("B").Resize(, Application.Match(dat, Rows(6), 0) - 2).Hidden = True 'masque les jours précédents
End Sub
Application.Match c'est la fonction EQUIV.

A+
 

Pièces jointes

  • Base(1).xlsm
    50.1 KB · Affichages: 3

Ricket77

XLDnaute Nouveau
Re à tous,

Je ne peux pas faire moins que @Robert 😜. Robert a commenté son code, je commente donc le mien !
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, n&
   If Intersect(Range("a1"), Target) Is Nothing Then Exit Sub  ' si la cellule A1 n'a pas changé, on ne fait rien
   Rows(1).EntireColumn.Hidden = False    ' on affiche toutes les colonnes
   ' x est la date du premier du mois : puis on retire à x le nombre de jours nécessaires pour avoir le lundi
   x = CDate(Join(Array(1, [a1], 2022))): x = x - Weekday(x, 2) + 1
   ' dans la ligne 6, on recherche le n° de colonne de la date x (si la date est absente, on retourne 0)
   n = Application.Evaluate("=IFERROR(MATCH(" & (1 * x) & ",6:6,0),0)")
   ' si la date existe en colonne n,  on masque les colonnes 2 à (n-1)
   If n > 0 Then Range(Cells(1, 2), Cells(1, n - 1)).EntireColumn.Hidden = True
End Sub
RE bonjour Robert.

En reprennent le code sur mon classeur, j'ai un problème, les colonnes entières ne ce masquent pas mais seulement les lignes qui contiennent les dates, malheureusement je ne peu pas fournir le fichier qui cause problème (données confidentielles)
Bonjour @Ricket77 :)

Bon, mes commentaires sont peu clairs. Je ne me vexe pas, je reste calme, serein et positif en ce dimanche ensoleillé 😄🤣

Je comprends ta remarque. Comme tu sembles intéressé à comprendre et que ce n'est pas souvent le cas, j'ai commenté à nouveau mon code mais en beaucoup plus détaillé.

Ne pas oublier non plus de consulter la DOC VBA, en sélectionnant l'instruction désirée et en tapant F1. L'aide n'est pas si mal faite (un peu moins que dans les versions précédentes car traduite automatiquement et imparfaitement corrigée - AMHA :()

Si tu as des questions, n'hésite pas à me les poser via ce fil ;)
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, n&

   ' Target est l'ensemble des cellules qui ont été modifiées. On cherche si la cellule A1 est parmi ces cellules.
   ' Si ce n'est pas le cas, on quitte la procédure puisque le mois n'a pas changé. Pour cela, on calcule l'intersection
   ' des cellules modifiées (Target) et de la cellule A1. On compare le résultat à l'ensemble vide (Nothing)
 
   If Intersect(Range("a1"), Target) Is Nothing Then Exit Sub  ' si la cellule A1 n'a pas changé, on ne fait rien
 
 
   ' on affiche toutes les colonnes. On considère la ligne 1 - rows(1). On en prend toutes les colonnes
   ' et on affiche toutes ces colonnes
 
   Rows(1).EntireColumn.Hidden = False
 
 
   ' on va constuire une chaine de caractère représentant le premier jour du mois choisi. Pour cela,
   ' on construit un tableau à une dimension contenant les trois éléments (1 , mois choisi , année)
   ' avec l 'instruction Array. Array(1, range("a1"),  2022) qu'on peut aussi écrire Array(1, [a1], 2022).
   ' Ensuite, on utilise l'instruction JOIN qui prend comme argument un tableau T à une dimension et
   ' une chaine de caractères SEP. JOIN(T,SEP) va concatener les éléments du tableau en les séparant
   ' par la chaine SEP. Si SEP est omis, alors le séparateur est par défaut le caractère espace.
   ' donc si Ai contient mars alors JOIN(Array(1, [a1],  2022) va donner la chaine "1 mars 2022"
   ' ça revient à faire : 1 & " " & Range("a1").value & " " & 2022
 
   ' le résultat est ensuite converti de texte en vraie date par CDATE(JOIN(Array(1, [a1],  2022))
   x = CDate(Join(Array(1, [a1], 2022)))
 
 
   ' il faut maintenant trouver le précédent lundi. Pour cela, on utilise Weekday(date,premier jour de la semaine)
   ' qui renvoie un nombre entre 1 et 7 représentant le jour de la semaine
   ' la paramètre premier jour de la semaine est pris égal à 2 qui veut dire que Weekday va considérer
   ' le lundi comme le premier jour de la semaine. Si date est un lundi alors weekday renverra 1,
   ' si date est un mardi alors weekday renverra 2, ..., si date est un dimanche alors weeeday renverra 7
 
   ' si x est un lundi, on doit soustraire 0 jour à x pour avoir le lundi     (weekday(x,2)renvoie 1)
   ' si x est un mardi, on doit soustraire 1 jour à x pour avoir le lundi     (weekday(x,2)renvoie 2)
   ' si x est un mercredi, on doit soustraire 2 jours à x pour avoir le lundi (weekday(x,2)renvoie 3)
   ' ...
   ' si x est un dimanche, on doit soustraire 6 jours à x pour avoir le lundi (weekday(x,2)renvoie 7)
 
   ' On voit donc qu'à partir de la date x du premier du mois, il faut soustraire à x le type de jour moins un
   ' soit x - (Weekday(x, 2) -1) qu'on peut aussi écrire
 
   x = x - Weekday(x, 2) + 1
 
 
   ' dans la ligne 6, on recherche le n° de colonne de la date x (si la date est absente, on retourne 0)
   ' Pour cela, la formule excel sur la feuille de calcul serait : SIERREUR(EQUIV(date du lundi; 6:6; 0), 0)
   '
   ' On va utiliser l'instruction Application.Evaluate(formule-texte) qui va évaluer (calculer)
   ' la formule-texte. Excemple Application.evaluate("11+2") renverra 13
 
   ' Il faut fabriquer l'instruction à évaluer (en anglais bien sûr!) en insérant comme paramètre la date du lundi
   ' soit "=IFERROR(MATCH(" & date-du-lundi & ",6:6,0),0)" qui donnerait =IFERROR(MATCH(date-du-lundi,6:6,0),0)
   ' on écrit donc ="IFERROR(MATCH("   &   x   &   ",6:6,0),0)"
   ' mais cela ne marchera pas car pour des raisons (que je ne développerai pas), il faut transformer la date en nombre.
   ' Pour cela, on multiplie la date x par 1 : (1 * x)
 
   n = Application.Evaluate("=IFERROR(MATCH(" & (1 * x) & ",6:6,0),0)")
 
   ' à ce stade n est soit le numéro de la colonne contenant la date du lundi x soit 0 (date non trouvée)
   ' si la date a été trouvée (x>0), alors on masque les colonnes 2 jusqu'à une colonne
   ' avant la colonne du lundi x soit la jusqu'à la colonne n-1
 
   If n > 0 Then Range(Cells(1, 2), Cells(1, n - 1)).EntireColumn.Hidden = True
End Sub
Merci beaucoup de ton retour 😉😊. En fait c'est simple j'aime "essayer" de comprendre et voir si je peux appliquer cela pour d'autres choses.
Si j'arrive à les implémenter pour d'autres tâches.

Ce qui est bizzare dans le fichier que je dois implémenter, j'ai repris ton code et les dates défiles bien mais les données restes à la même place.

J'ai aussi eu une erreur sur ce bout de code : x = CDate(Join(Array(1, [a1], 2022))) et est-ce que je peu définir 2022 par une cellule ce trouvant dans l'onglet "date" qui peu évoluer si l'on change d'année.

Malheureusement, je ne peux pas transmettre mon fichier original car données sensible.

Merci pour le temps passé à me / nous répondre.
 

Ricket77

XLDnaute Nouveau
Bonjour Ricket77, Robert, mapomme,

Puisqu'on veut qu'un mois commence le lundi il faut peut-être que l'année 2022 commence le 27/12/2021.

Voyez le fichier joint et cette macro :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dat As Long
Columns.Hidden = False 'affiche toutes les colonnes
On Error Resume Next 'si A1 est vide où si le jour n'existe pas
dat = CDate("1/" & [A1]) - Weekday(CDate("1/" & [A1]), 2) + 1 'lundi précédent le 1er du mois
Columns("B").Resize(, Application.Match(dat, Rows(6), 0) - 2).Hidden = True 'masque les jours précédents
End Sub
Application.Match c'est la fonction EQUIV.

A+
Bonjour Ricket77, Robert, mapomme,

Puisqu'on veut qu'un mois commence le lundi il faut peut-être que l'année 2022 commence le 27/12/2021.

Voyez le fichier joint et cette macro :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dat As Long
Columns.Hidden = False 'affiche toutes les colonnes
On Error Resume Next 'si A1 est vide où si le jour n'existe pas
dat = CDate("1/" & [A1]) - Weekday(CDate("1/" & [A1]), 2) + 1 'lundi précédent le 1er du mois
Columns("B").Resize(, Application.Match(dat, Rows(6), 0) - 2).Hidden = True 'masque les jours précédents
End Sub
Application.Match c'est la fonction EQUIV.

A+
Bonjour Job75,
Merci pour ton retour qui est très pertinent.
Je n'avais pas pensé à cela étant donné que l'on est déjà au mois de juillet mais la feuille risque de rester tel quel pour 2023 😊donc oui cela m'arrange bien mais il y a un bout de code qui me gêne celui qui est écrit en dur 2022.

Merci
 

mapomme

XLDnaute Barbatruc
Supporter XLD
J'ai aussi eu une erreur sur ce bout de code : x = CDate(Join(Array(1, [a1], 2022))) et est-ce que je peu définir 2022 par une cellule ce trouvant dans l'onglet "date" qui peu évoluer si l'on change d'année.

Quelle erreur ?


Si l'année est variable et si sa valeur est dans une cellule (disons A13) de l'onglet "Date", on peut écrire :
x = CDate(Join(Array(1, [a1], sheets("Date").range("A13")))

Si vous désirez l'année en cours, on peut écrire:
x = CDate(Join(Array(1, [a1], Year(date) )))

edit : bonjour @job75 ;)
 

Ricket77

XLDnaute Nouveau
Dans ma macro l'année 2022 n'est pas écrite en dur.

Le mois en A1 est toujours considéré être le mois de l'année en cours.

Donc la macro fonctionnera pour les années qui suivront 2022.
Oui effectivement je n'ai pas pris le temps de bien regarder ton code, j'avais encore en tête celui de Robert ou de Popomme.

Merci beaucoup Job75. Je vais
Bonjour @Ricket77 :)

Bon, mes commentaires sont peu clairs. Je ne me vexe pas, je reste calme, serein et positif en ce dimanche ensoleillé 😄🤣

Je comprends ta remarque. Comme tu sembles intéressé à comprendre et que ce n'est pas souvent le cas, j'ai commenté à nouveau mon code mais en beaucoup plus détaillé.

Ne pas oublier non plus de consulter la DOC VBA, en sélectionnant l'instruction désirée et en tapant F1. L'aide n'est pas si mal faite (un peu moins que dans les versions précédentes car traduite automatiquement et imparfaitement corrigée - AMHA :()

Si tu as des questions, n'hésite pas à me les poser via ce fil ;)
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x, n&

   ' Target est l'ensemble des cellules qui ont été modifiées. On cherche si la cellule A1 est parmi ces cellules.
   ' Si ce n'est pas le cas, on quitte la procédure puisque le mois n'a pas changé. Pour cela, on calcule l'intersection
   ' des cellules modifiées (Target) et de la cellule A1. On compare le résultat à l'ensemble vide (Nothing)
 
   If Intersect(Range("a1"), Target) Is Nothing Then Exit Sub  ' si la cellule A1 n'a pas changé, on ne fait rien
 
 
   ' on affiche toutes les colonnes. On considère la ligne 1 - rows(1). On en prend toutes les colonnes
   ' et on affiche toutes ces colonnes
 
   Rows(1).EntireColumn.Hidden = False
 
 
   ' on va constuire une chaine de caractère représentant le premier jour du mois choisi. Pour cela,
   ' on construit un tableau à une dimension contenant les trois éléments (1 , mois choisi , année)
   ' avec l 'instruction Array. Array(1, range("a1"),  2022) qu'on peut aussi écrire Array(1, [a1], 2022).
   ' Ensuite, on utilise l'instruction JOIN qui prend comme argument un tableau T à une dimension et
   ' une chaine de caractères SEP. JOIN(T,SEP) va concatener les éléments du tableau en les séparant
   ' par la chaine SEP. Si SEP est omis, alors le séparateur est par défaut le caractère espace.
   ' donc si Ai contient mars alors JOIN(Array(1, [a1],  2022) va donner la chaine "1 mars 2022"
   ' ça revient à faire : 1 & " " & Range("a1").value & " " & 2022
 
   ' le résultat est ensuite converti de texte en vraie date par CDATE(JOIN(Array(1, [a1],  2022))
   x = CDate(Join(Array(1, [a1], 2022)))
 
 
   ' il faut maintenant trouver le précédent lundi. Pour cela, on utilise Weekday(date,premier jour de la semaine)
   ' qui renvoie un nombre entre 1 et 7 représentant le jour de la semaine
   ' la paramètre premier jour de la semaine est pris égal à 2 qui veut dire que Weekday va considérer
   ' le lundi comme le premier jour de la semaine. Si date est un lundi alors weekday renverra 1,
   ' si date est un mardi alors weekday renverra 2, ..., si date est un dimanche alors weeeday renverra 7
 
   ' si x est un lundi, on doit soustraire 0 jour à x pour avoir le lundi     (weekday(x,2)renvoie 1)
   ' si x est un mardi, on doit soustraire 1 jour à x pour avoir le lundi     (weekday(x,2)renvoie 2)
   ' si x est un mercredi, on doit soustraire 2 jours à x pour avoir le lundi (weekday(x,2)renvoie 3)
   ' ...
   ' si x est un dimanche, on doit soustraire 6 jours à x pour avoir le lundi (weekday(x,2)renvoie 7)
 
   ' On voit donc qu'à partir de la date x du premier du mois, il faut soustraire à x le type de jour moins un
   ' soit x - (Weekday(x, 2) -1) qu'on peut aussi écrire
 
   x = x - Weekday(x, 2) + 1
 
 
   ' dans la ligne 6, on recherche le n° de colonne de la date x (si la date est absente, on retourne 0)
   ' Pour cela, la formule excel sur la feuille de calcul serait : SIERREUR(EQUIV(date du lundi; 6:6; 0), 0)
   '
   ' On va utiliser l'instruction Application.Evaluate(formule-texte) qui va évaluer (calculer)
   ' la formule-texte. Excemple Application.evaluate("11+2") renverra 13
 
   ' Il faut fabriquer l'instruction à évaluer (en anglais bien sûr!) en insérant comme paramètre la date du lundi
   ' soit "=IFERROR(MATCH(" & date-du-lundi & ",6:6,0),0)" qui donnerait =IFERROR(MATCH(date-du-lundi,6:6,0),0)
   ' on écrit donc ="IFERROR(MATCH("   &   x   &   ",6:6,0),0)"
   ' mais cela ne marchera pas car pour des raisons (que je ne développerai pas), il faut transformer la date en nombre.
   ' Pour cela, on multiplie la date x par 1 : (1 * x)
 
   n = Application.Evaluate("=IFERROR(MATCH(" & (1 * x) & ",6:6,0),0)")
 
   ' à ce stade n est soit le numéro de la colonne contenant la date du lundi x soit 0 (date non trouvée)
   ' si la date a été trouvée (x>0), alors on masque les colonnes 2 jusqu'à une colonne
   ' avant la colonne du lundi x soit la jusqu'à la colonne n-1
 
   If n > 0 Then Range(Cells(1, 2), Cells(1, n - 1)).EntireColumn.Hidden = True
End Sub
Bonjour mapomme, je crois que je n'ai pas d'autre choix que d'envoyer mon fichier original (en ayant supprimer les données sensible ;-) ) j'ai appliqué les différents code donnés mais aucun ne fonctionnent o_O

je ne sais pas ou est mon erreur et j'ai essayé d'éplucher, mais j'aimerais vraiment comprendre ou est mon erreur.
le bout de code doit ce trouver sur l'onglet "planG", je sais que je sors du sujet mais sur l'onglet "planC" en A2 la date soit reportée depuis la date du lundi affiché sur "planG".

Merci pour votre aide...
 

Pièces jointes

  • General.xlsm
    441.9 KB · Affichages: 4

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Ricket77,

Les données ont changé par rapport à ton premier fichier. La cellule A1 de la feuille PlanG contient une vraie date au sens Excel et non pas un texte désignant le mois.
Les codes ne sont donc plus les mêmes. D'où l'utilité de bien joindre un fichier "représentatif" dès le départ.
On peut donc directement utiliser la valeur de A1 sans conversion:
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dat As Long
Columns.Hidden = False 'affiche toutes les colonnes
On Error Resume Next 'si A1 est vide où si le jour n'existe pas
dat = [a1] - Weekday([a1], 2) + 1  'lundi précédent le 1er du mois
Columns("B").Resize(, Application.Match(dat, Rows(6), 0) - 2).Hidden = True 'masque les jours précédents
End Sub
 

Ricket77

XLDnaute Nouveau
Bonjour @Ricket77,

Les données ont changé par rapport à ton premier fichier. La cellule A1 de la feuille PlanG contient une vraie date au sens Excel et non pas un texte désignant le mois.
Les codes ne sont donc plus les mêmes. D'où l'utilité de bien joindre un fichier "représentatif" dès le départ.
On peut donc directement utiliser la valeur de A1 sans conversion:
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dat As Long
Columns.Hidden = False 'affiche toutes les colonnes
On Error Resume Next 'si A1 est vide où si le jour n'existe pas
dat = [a1] - Weekday([a1], 2) + 1  'lundi précédent le 1er du mois
Columns("B").Resize(, Application.Match(dat, Rows(6), 0) - 2).Hidden = True 'masque les jours précédents
End Sub
Oups pardon, 😬.
Effectivement cela va beaucoup mieux.
Et pour la 2ème question, qui n'avait rien a voir avec ce sujet, j'ai trouvé.

Merci beaucoup de ton aide, et d'avoir si bien détaillé les différentes étapes du codes
Nous avons tous des compétences dans des domaines différents. 😉

Merci a tous les intervenants de ce site, mon problème a été résolu...
 

Discussions similaires

Statistiques des forums

Discussions
312 113
Messages
2 085 422
Membres
102 886
dernier inscrit
eurlece