Somme plage après insertion de ligne

[Lone-wolf]

Bonjour à tous

Dans le fichier joint, j'ai une macro pour inserer une ligne en dessous de chaque vendredi(tous les vendredis de cette année). Ce que je n'arrive pas à faire, c'est d'inclure dans la cellule vide, en colonne B le total de la semaine. Un ch'tit coup de main serait le bienvenu.

 

[R@chid]

Re : Somme plage après insertion de ligne

Bonjour Lone-wolf,
je ne suis pas un spécialiste en macro, mais j'ai constaté une anomalie sur cette macro, il ne faut qu'il ne s’exécute qu'une seule fois sinon il faut qu'elle prenne en compte les vendredis car si tu continues à l’exécuter comme elle est elle va pas cesser d’insérer des lignes.

 

[bibba]

Re : Somme plage après insertion de ligne

j'allais dire la même chose, chaque fin de semaine, quand tu vas cliquer sur ton bouton tu vas réinsérer une nouvelle ligne à chaque fois, y compris sur les semaines passées...

 

[gosselien]

Re : Somme plage après insertion de ligne

Bonjour à tous,

un petit essai

P.

Sub VendrediEtRobinson()
Dim plage As Range
Dim i As Long
Dim Last As Long
Last = [A65000].End(xlUp).Row
Application.ScreenUpdating = False
  For i = Last To 2 Step -1
    If Weekday(Cells(i, 1)) = 2 Then ' sous le vendredi
      Cells(i, 1).EntireRow.Insert shift:=xlDown
    End If
  Next i
totaux
End Sub


Sub totaux()
Dim Last As Long
Last = [A65000].End(xlUp).Row + 1
For i = Last To 2 Step -1
  If Weekday(Cells(i, 1)) = 6 Then
    Cells(i + 1, 2).FormulaR1C1 = "=SUM(R[-1]C:R[-5]C)"
  End If
Next
End Sub

 

[job75]

Re : Somme plage après insertion de ligne

Bonjour Lone-wolf, R@chid, gosselien,

Avec des tableaux VBA c'est très rapide :

Sub SousTotaux()
Dim P As Range, t, rest(), i&, n&, a#, b#, c#, d#
With Feuil1 'CodeName
  Set P = .Range("A2:B" & .Range("A" & .Rows.Count).End(xlUp)(2).Row)
End With
On Error Resume Next
P.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
P.Columns(1).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
t = P 'matrice, plus rapide
On Error GoTo 0
If Not IsArray(t) Then Exit Sub
ReDim rest(1 To 1 + Int(1.2 * UBound(t)), 1 To 2)
For i = 1 To UBound(t)
  n = n + 1
  rest(n, 1) = t(i, 1)
  rest(n, 2) = t(i, 2)
  If i Mod 5 = 0 Then
    n = n + 1
    'rest(n, 1) = "S/TOTAL" 'facultatif, je vous laisse tester
    a = Val(Replace(t(i - 4, 2), ",", ".")): b = Val(Replace(t(i - 3, 2), ",", "."))
    c = Val(Replace(t(i - 2, 2), ",", ".")): d = Val(Replace(t(i - 1, 2), ",", "."))
    rest(n, 2) = a + b + c + d + Val(Replace(t(i, 2), ",", "."))
  End If
Next
P.Resize(n) = rest
End Sub

Fichier joint.

A+

 

[job75]

Re : Somme plage après insertion de ligne

Re,

Pour le fun j'ai testé un tableau de 100 000 lignes - ça nous emmène jusqu'en 2399

La macro s'exécute chez moi en 1,4 seconde, mais si l'on clique de nouveau sur le bouton la suppression des lignes par les SpecialCells prend un temps fou.

Il faut donc faire un tri sur la colonne A avant ces suppressions :

Sub SousTotaux()
Dim dur#, P As Range, t, rest(), i&, n&, a#, b#, c#, d#
dur = Timer
With Feuil1 'CodeName
  Set P = .Range("A2:B" & .Range("A" & .Rows.Count).End(xlUp)(2).Row)
End With
P.Sort P(1), xlAscending, Header:=xlNo 'tri pour accélérer
On Error Resume Next
P.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
P.Columns(1).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
t = P 'matrice, plus rapide
On Error GoTo 0
If Not IsArray(t) Then Exit Sub
ReDim rest(1 To 1 + Int(1.2 * UBound(t)), 1 To 2)
For i = 1 To UBound(t)
  n = n + 1
  rest(n, 1) = t(i, 1)
  rest(n, 2) = t(i, 2)
  If i Mod 5 = 0 Then
    n = n + 1
    'rest(n, 1) = "S/TOTAL" 'facultatif, je vous laisse tester
    a = Val(Replace(t(i - 4, 2), ",", ".")): b = Val(Replace(t(i - 3, 2), ",", "."))
    c = Val(Replace(t(i - 2, 2), ",", ".")): d = Val(Replace(t(i - 1, 2), ",", "."))
    rest(n, 2) = a + b + c + d + Val(Replace(t(i, 2), ",", "."))
  End If
Next
P.Resize(n) = rest
MsgBox "Durée " & Format(Timer - dur, "0.00 \s") 'mesure facultative
End Sub

Fichier zippé joint.

A+

 

[Lone-wolf]

Re : Somme plage après insertion de ligne

Bonsoir à tous
R@chid, bibba, gosselien, job
moi-même

@R@chid et bibba: c'est vrai que je n'ai pas testé la macro à plusieures reprises, merci de m'avoir avverti.

@gosselien et job: je testerais sur mon ordi, là je suis sur l'ordi de ma fille; mon gamin à encore fait des siennes

 

[Lone-wolf]

Re : Somme plage après insertion de ligne

Bonsoir job, gosselien

avec mon portable pour le tableau de 100000 lignes, j'arrive à environ 5 sec. Mais bon, comme il n'a pas un moteur de 500 chevaux, c'est compréhensible. Et pour ma part, faut déjà espérer que j'arrive à la retraite.

@gosselien: même problème que le mien, en recliquant sur le bouton, elle insère une ligne.

Merci à tous les deux en tout cas

 

[Bebere]

Re : Somme plage après insertion de ligne

bonjour lonewolf,Job,Rachid,Gosselien
une autre solution

Sub test()

Dim i As Long

Application.ScreenUpdating = False

If Weekday(Date) = vbFriday Then
For i = 6 To 262
If Weekday(Range("a" & i)) = vbFriday Then
If Weekday(Range("a" & i).Offset(1, 0)) = vbMonday Then
Rows(i + 1).Insert Shift:=xlDown
Range("B" & i + 1) = Application.Sum(Range("b" & i - 4 & ":B" & i))
Exit For
End If
End If
Next i
End If

Application.ScreenUpdating = True