XL 2010 [Résolu] Insertion numéro de semaine et masquage tableaux selon critères

[Lone-wolf]

Bonjour à tous (enfin... je devrait dire rebonjour )

Dans le fichier joint, il y a déjà la fonction pour afficher les numéro de semaines; mais comme il y à 12 tableaux(12 mois), je ne sais pas comment m'y prendre; à partir de C8 jusqu'à AG 184 faire une boucle avec Step 14.

J'aimerais aussi afficher les tableaux selon les dates de début et de fin (mois) qui varient.

 

[pierrejean]

Bonjour Lone-Wolf

A tester Apres avoir neutralisé la macro Private Sub Worksheet_Change(ByVal Target As Range):
Sub report_semaine()
Dim n As Integer
Dim m As Integer
For n = 8 To 184 Step 16
For m = 3 To 33
Cells(n, m).Value = NOSEM(Cells(n + 3, m))
Next
Next
End Sub

 

[Lone-wolf]

Bonjour pierrejean

Merci pour le coup de main. La macro est bien mais, ça insert des doublons. Il y a moyen des les supprimer pour n'avoir que 1 numéro par semaine, merci beaucoup.

Et pour la 2ème demande du post #1, c'est possible de le faire? Encore une fois, merci.

 

[pierrejean]

Re
Vois si cela te convient

Sub report_semaine()
Dim n As Integer
Dim m As Integer
Dim mem As Integer
For n = 8 To 184 Step 16
mem = NOSEM(Cells(11, 3))
For m = 3 To 33
If NOSEM(Cells(n + 3, m)) <> mem And Cells(n + 3, m) <> "" Then
Cells(n, m).Value = NOSEM(Cells(n + 3, m))
mem = NOSEM(Cells(n + 3, m))
End If
Next
Next
End Sub

 

[Lone-wolf]

Re pierrjean

Désolé, mais ce n'est pas encore au point. En changeant les années par exemple de 2018 à 2016 la semaine 1 n'apparaît pas. Si possible, il faut le numéro soit décalé sur tous les lundi, mis à part le mois de janvier qui doit afficher 53 (3 4 jours de différence) puis 1, puisque la semaine 52 ou 53 peux être à cheval entre le 31 décembre et le 1er janvier.

 

[job75]

Bonsoir Lone-wolf, Pierre,

Vraiment pas besoin de VBA pour les numéros de semaines (norme ISO), formule en C8 :

=SI(NB.SI($B8:B8;NO.SEMAINE.ISO(C11))+(C11="");"";NO.SEMAINE.ISO(C11))

A tirer à droite jusqu'en AG8 puis copier la ligne 8 sur les lignes 24, 40, 56 etc...

A+

 

[Lone-wolf]

Bonsoir job , pierrejean

Merci pour la proposition, mais j'ai pu régler le problème en faisant comme ceci dans l'évenement change

If Cells(11, 3) <> "" Then
        For n = 8 To 184 Step 16
            mem = NOSEM(Cells(11, 3))
            For ms = 3 To 33
                If Cells(n + 3, ms).Value Mod 7 = 2 Or (n = 3 And ms = 3) Then
                    Cells(n, ms).Value = "sem: " & NOSEM(Cells(n + 3, ms))
                Else
                    Cells(8, 3).Value = "sem: " & NOSEM(Cells(11, 3))
                End If
            Next ms
        Next n
        End If

Il reste encore un problème à regler, masquer les tableaux superposés suite à une période donnée (début mois - fin mois) suivant le choix des listes.

 

[job75]

Re,

Pour ce qui est de l'affichage des mois, dans le code de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [E2,G2]) Is Nothing Then Exit Sub
Dim x, y, i&, a&, b&
x = Replace([E2].Value, ".", "/"): y = Replace([G2], ".", "/")
If Not IsDate(x) Or Not IsDate(y) Then Rows.Hidden = False: Exit Sub
x = CLng(CDate(x)): y = CLng(CDate(y))
For i = 11 To 187 Step 16
  If IsNumeric(Application.Match(x, Rows(i), 0)) Then a = i
  If IsNumeric(Application.Match(y, Rows(i), 0)) Then b = i
Next
Application.ScreenUpdating = False
Rows("8:198").Hidden = True
Range(Rows(a - 3).Resize(15), Rows(b - 3).Resize(15)).Hidden = False
End Sub

Bonne nuit.

 

[Lone-wolf]

Job, encore une fois je m'incline devant tant de maîtrise. Merci infiniment.

Très bonne nuit à toi aussi.

 

[Jacky67]

J'aimerais aussi afficher les tableaux selon les dates de début et de fin (mois) qui varient.

Bonjour,
Autre possibilité
- calendrier MAJ selon l'année
- n° de semaine
- affichage selon le mois

 

[Lone-wolf]

Bonjour jacky

Interessant! . Il est vrai que ce sont de grands tableaux, mais on à pas de possibilité de voir des périodes trimestrielles par exemple.

 

[Jacky67]

.......mais on à pas de possibilité de voir des périodes trimestrielles par exemple.

Re...
Si..si

 

[job75]

Bonjour Lone-wolf, Pierre, jacky67, le forum,

Je termine avec la validation de l'année en cellule I2 :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dat$, i&, j%, liste1$, liste2$, x, y, a&, b&
'---cellule I2---
If Not Intersect(Target, [I2]) Is Nothing Then
  dat = "1/1/" & [I2]
  [E2,G2] = ""
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  For i = 11 To 187 Step 16
    If IsDate(dat) Then
      If i = 11 Then Cells(i, 3) = CDate(dat) Else Cells(i, 3) = Application.Max(Rows(i - 16)) + 1
      Cells(i, 3).Resize(, 31).DataSeries Type:=xlChronological, Date:=xlDay
      For j = 29 To 31 'contrôle des 3 derniers jours
        If Day(Cells(i, j + 2)) < 4 Then Cells(i, j + 2) = ""
      Next j
      Cells(i - 3, 3).Resize(, 31) = "=IF(COUNTIF(RC2:RC[-1],ISOWEEKNUM(R[3]C))+(R[3]C=""""),"""",ISOWEEKNUM(R[3]C))"
      Cells(i - 3, 3).Resize(, 31) = Cells(i - 3, 3).Resize(, 31).Value 'supprime les formules
      liste1 = liste1 & "," & Format(Cells(i, 3), "dd.mm.yyyy")
      liste2 = liste2 & "," & Format(Application.Max(Rows(i)), "dd.mm.yyyy")
    Else
      Union(Cells(i, 3).Resize(, 31), Cells(i - 3, 3).Resize(, 31)) = "" 'RAZ
    End If
  Next i
  [E2,G2].Validation.Delete
  If IsDate(dat) Then
    [E2].Validation.Add xlValidateList, Formula1:=Mid(liste1, 2)
    [G2].Validation.Add xlValidateList, Formula1:=Mid(liste2, 2)
  End If
  Application.EnableEvents = True
End If
'---cellules E2 et G2---
If Intersect(Target, [E2,G2]) Is Nothing Then Exit Sub
x = Replace([E2].Value, ".", "/"): y = Replace([G2], ".", "/")
If Not IsDate(x) Or Not IsDate(y) Then Rows.Hidden = False: Exit Sub
x = CLng(CDate(x)): y = CLng(CDate(y))
For i = 11 To 187 Step 16
  If IsNumeric(Application.Match(x, Rows(i), 0)) Then a = i
  If IsNumeric(Application.Match(y, Rows(i), 0)) Then b = i
Next i
Application.ScreenUpdating = False
Rows("8:198").Hidden = True
Range(Rows(a - 3).Resize(15), Rows(b - 3).Resize(15)).Hidden = False
End Sub

Comme je suis têtu j'utilise la formule de mon post #6 avec ISOWEEKNUM, c'est vraiment hyper simple.

Fichier joint.

A+

 

[Lone-wolf]

Re jacky, bonjour job

Merci à tous les deux pour vos propositions.

Jacky, je ne comprend pas comment au changement de l'année, samedi et dimanche prenne un fond gris, je ne vois nul part la mise en forme ou la mise en forme conditionnelle???

EDIT: des fois... il fallait selectionner les colonnes pour voir la formule.

 

[Jacky67]

EDIT: des fois... il fallait selectionner les colonnes pour voir la formule.

RE...
Ou dans le menu de la MFC, sélectionner ==> "Cette feuille de calcul"