Bonjour, teste ceci, évidemment les sous-totaux ajoutés modifient les résultats de tes formules.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
| Sub AjouterSousTotal()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Feuil1") ' Remplace "NomDeTaFeuille" par le nom réel de ta feuille
Dim totalMinimum As Double
totalMinimum = 23.8
Dim ligne As Integer
ligne = 2 ' Commence à la deuxième ligne, puisque la première ligne est une en-tête
Do While ws.Cells(ligne, 1).Value <> "" ' Continue tant que la cellule n'est pas vide
Dim totalPartiel As Double
totalPartiel = 0
Do
totalPartiel = totalPartiel + ws.Cells(ligne, 1).Value
ligne = ligne + 1
Loop Until totalPartiel >= totalMinimum Or ws.Cells(ligne, 1).Value = "" ' Continue tant que le total partiel est inférieur au minimum ou que la cellule est vide
If totalPartiel >= totalMinimum Then
' Insérer une nouvelle cellule
ws.Cells(ligne, 1).Insert Shift:=xlDown
' Insérer le sous-total
ws.Cells(ligne, 1).Value = totalPartiel
' Se décaler d'une ligne vers le bas pour calculer sous-total suivant
ligne = ligne + 1
End If
Loop
End Sub |
[EDIT]
J'ai constaté que la dernière cellule contenant la formule, était aussi additionnée, il faut donc remplacer la ligne DO WHILE par:
Do While ws.Cells(ligne, 1).Value <> "" And ws.Cells(ligne + 1, 1).HasFormula = False
Si tu remplaces ta formule en A26 par =SOMME.SI(A2:A25;"<23,8") tu obtiendras le résultat correct, sans additionner les sous-totaux.
Partager