Problème avec la fonction weeknum

[gillmo]

Bonjour,

Sur une fiche, je souhaite insérer une ligne grisé entre chaque semaine de la colonne A

J'ai fais une macro "insert" qui fonctionne sur un autre fichier, mais que je n'arrive pas à faire tourner sur le fichier joint.

Si vous pouvez m'apporter votre aide.

Cordialement

 

[Paf]

Bonjour gillmo,

bien que n'ayant pu faire tourner la macro sur XL 2003 (Weeknum non reconnu), ce que j'ai noté :
1- en colonne A les lignes 36 à 152 ne sont pas vides malgré les apparences et
DerLig = Sheets("Fiche").Range("A141").End(xlUp).Row + 1 donne 9, soit le début utile du tableau et on ne fera qu'une seule boucle : For i= 9 to 9
a priori en 'effaçant' ces cellules vides on obtient bien la dernière ligne
2- on utilise With Sheets("Fiche") , mais aucun range ou Cells n'y est rattaché ( pas de point . )
3- on a 36 comme dernière ligne , on boucle donc de 9 à 36 , mais, puisqu'on insère régulièrement des lignes, les données de la lignes 36 (initialement) vont se retrouvées en ligne 40 ou 45 ...( selon le nombre de lignes insérées). et ces dernières valeurs ne seront jamais traitées.
Il vaut mieux dans ce cas boucler en commençant par la fin :

je prend l'avant dernière ligne (35) je compare avec la ligne suivante (36) éventuellement j'insère une ligne ( qui devient la 36), je passe à la suivante (34) .....

A+

 

[job75]

Bonjour gillmo, Paf,

Sub Insert()
Dim P As Range, i&
Set P = Intersect(ActiveSheet.UsedRange.EntireRow, Range("A9:D" & Rows.Count))
If P Is Nothing Then Exit Sub
Application.ScreenUpdating = False
P.Interior.ColorIndex = xlNone 'RAZ
P.Sort P(1), xlAscending, Header:=xlNo 'tri
For i = P.Rows.Count To 2 Step -1
  If IsDate(P(i, 1)) Then
    If Application.WeekNum(P(i, 1)) <> Application.WeekNum(P(i - 1, 1)) Then
      P.Rows(i).Insert xlDown
      P.Rows(i).Interior.ColorIndex = 15 'gris
    End If
  End If
Next
End Sub

A+

 

[job75]

Re,

Bien entendu compte tenu du tri il faut mettre les textes des cellules A154 A156 A158 en B154 B156 B158.

A+

 

[job75]

Re,

On aura constaté que si l'on exécute plusieurs fois de suite la macro précédente la ligne du TOTAL se décale vers le bas.

C'est normal puisque des lignes sont insérées, mais pour l'éviter utiliser :

Sub Insert()
Dim P As Range, i&
Set P = Intersect(ActiveSheet.UsedRange.EntireRow, Range("A9:D" & Rows.Count))
If P Is Nothing Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next 'sécurité
For i = P.Rows.Count To 1 Step -1
  If P(i, 1).Interior.ColorIndex = 15 Then P.Rows(i).Delete xlUp
Next
P.Sort P(1), xlAscending, Header:=xlNo 'tri
For i = P.Rows.Count To 2 Step -1
  If IsDate(P(i, 1)) Then
    If Application.WeekNum(P(i, 1)) <> Application.WeekNum(P(i - 1, 1)) Then
      P.Rows(i).Insert xlDown
      P.Rows(i).Interior.ColorIndex = 15 'gris
    End If
  End If
Next
End Sub

A+

 

[gillmo]

Merci à vous, ça fonctionne nickel avec le code de job

Cordialement.