Somme - besoin d'une macro

Gorfael à dit:

Salut Julien et le forum
Je n'utilise pas les couleurs : une différence, invisible à l'oeil, l'est pour excel. Je me suis basé sur les sommes en colonne E :

Code:

Sub Test()
'Déclaration ===========================
Dim Cel As Range
Dim X As Long, Tablo() As Long
Dim Str_1 As String
'initialisation ========================
ReDim Tablo(0)
Tablo(0) = Range("E1").End(xlDown).Row - 1
'recherche des sommes ==================
Set Cel = Range("E:E").Find("Somme")
Do
    ReDim Preserve Tablo(UBound(Tablo) + 1)
    Tablo(UBound(Tablo)) = Cel.Row
    Set Cel = Range("E:E").FindNext(Cel)
    If Cel.Row = Tablo(1) And UBound(Tablo) > 1 Then Exit Do
Loop
If UBound(Tablo) > 1 And Tablo(UBound(Tablo)) = Tablo(UBound(Tablo) - 1) + 1 Then
    For X = 1 To UBound(Tablo) - 1
        Str_1 = Str_1 & Tablo(X) & "; F"
    Next X
    Set Cel = Range("F" & Tablo(UBound(Tablo)))
    Cel.FormulaLocal = "=somme(F" & Left(Str_1, Len(Str_1) - 3) & ")"
    Cel.AutoFill Destination:=Range(Cel, Cells(Cel.Row, [A1].SpecialCells(xlCellTypeLastCell).Column))
End If
For X = 1 To UBound(Tablo) - 1
    Set Cel = Range("F" & Tablo(X))
    Cel.FormulaLocal = "=somme(F" & Tablo(X - 1) + 1 & ":F" & Tablo(X) - 1 & ")"
    Cel.AutoFill Destination:=Range(Cel, Cells(Cel.Row, [A1].SpecialCells(xlCellTypeLastCell).Column))
Next X
End Sub

ça fonctionne sur le bout de fichier donné : ça fait la somme des lignes au-dessus. la dernière somme fait l'addition des lignes contenant le mot Somme en E (ce qui n'est pas le cas pour le fichier d'essai)
A+

Cliquez pour agrandir...

Julien.B à dit:

il semble que cela bug sur la ligne suivante
Cel.FormulaLocal = "=Somme(F" & Left(Str_1, Len(Str_1) - 3) & ")"

Cliquez pour agrandir...

Cel.Formula = "=Somme(F" & Left(Str_1, Len(Str_1) - 3) & ")"