Problème avec la fonction weeknum

gillmo

XLDnaute Occasionnel
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
 

Pièces jointes

  • Classeur2.xlsm
    29.1 KB · Affichages: 34

Paf

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Bonjour gillmo, Paf,
Code:
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

XLDnaute Barbatruc
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 :
Code:
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+
 

Discussions similaires

Réponses
5
Affichages
285

Statistiques des forums

Discussions
312 922
Messages
2 093 659
Membres
105 779
dernier inscrit
le routier