Macro pour somme dans première cellule vide

Bonjour à tous et merci d'avance de me lire

Voici mon petit soucis:

En colonne A: une succession de listes séparées par une ligne vide
A1 à A14: camion
A15: ligne vierge
A16 à A29: table

en colonne B sont associés des valeurs

Pour chaque liste: je veux effectuer la somme de la colonne B jusqu'à la ligne vide. et afficher le résultat de cette somme dans cette ligne vide, en colonne B.

par exemple: en B15, la somme de B1 jusqu'à la dernière cellule non vide, ie B14 !
en B30: la somme de B16 jusqu'à B29.

La longueur des listes va changer, d'où l'utilisation de macro et du calcul de la première cellule non vide.

Je peut envoyer mon fichier qui sera beaucoup plus explicite!!

Merci encore :)

2 réponses

  1. Bonsoir Aud, bonsoir le forum,

    J'ai pour habitude de commenter mes codes mais là il est trop tard et j'ai la flemme. Je te les livre bruts (mais testés)...

    Sub Macro1()
    Dim DL As Integer
    Dim TC As Variant
    Dim I As Integer
    Dim TLV() As Integer
    Dim J As Integer
    
    DL = Cells(Application.Rows.Count, 1).End(xlUp).Row
    TC = Range("A1:B" & DL)
    ReDim Preserve TLV(J)
    TLV(J) = -1: J = J + 1
    For I = 1 To UBound(TC, 1)
        If TC(I, 1) = "" Then
            ReDim Preserve TLV(J)
            TLV(J) = I - 1
            J = J + 1
        End If
    Next I
    ReDim Preserve TLV(J)
    TLV(J) = DL
    For J = 1 To UBound(TLV)
        Cells(TLV(J) + 1, 1).Value = "Total"
        Cells(TLV(J) + 1, 2).Value = Application.WorksheetFunction.Sum(Range(Cells(TLV(J - 1) + 2, 2), Cells(TLV(J), 2)))
        Cells(TLV(J) + 1, 1).Resize(1, 2).Font.Bold = True
    Next J
    End Sub

    0
    1. Modérateur
      Bonjour Aud, ThauTheme, le forum,

      Excusez l'incruste...

      Une variante :

      Sub Aud()
      Dim Tb(), DL As Long, i As Long, Somme As Double
      
      Const PremLigne As Integer = 1 ' à adapter = 1ère ligne, ici A1
      
      'collecte des données
      DL = Range("A" & Rows.Count).End(xlUp).Row
      Tb = Range("A" & PremLigne & ":B" & DL)
      
      'boucle sur les données
      For i = LBound(Tb, 1) To UBound(Tb, 1)
          'si Ai est vide alors
          If Tb(i, 1) = "" Then
              Tb(i, 1) = "Total" 'Ai = "TOTAL"
              Tb(i, 2) = Somme 'Bi = Somme
              Somme = 0 'On réinitialise la somme
          Else 'sinon, si Ai non vide
              Somme = Somme + Tb(i, 2) ' on fait la somme des B
          End If
      Next i
      'restitution des données
      Range("A" & PremLigne).Resize(UBound(Tb), 2) = Tb
      'sans oublier la dernière somme
      Range("A" & DL + 1) = "Total": Range("B" & DL + 1) = Somme
      End Sub

      0
      1. Bonjour Pikaju,

        On n'excuse pas l'incruste... On l'apprécie !
        0
      2. Modérateur
        @ThauThemeSalut ThauTheme,

        Bon, puisque tu le prends comme ça ;-)

        Une variante "rigolote" s'impose :
        Sub AUD()
        Dim Adress() As String
        
        Adress = Split("$B$1," & Range("B1:B" & Cells(Application.Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).Offset(1, 0).Address & ",$B$" & Cells(Application.Rows.Count, 1).End(xlUp).Row + 2, ",")
        For i = 0 To UBound(Adress) - 1
            Range(Adress(i + 1)).Offset(-1, -1) = "TOTAL"
            Range(Adress(i + 1)).Offset(-1, 0) = Evaluate("SUM(" & Adress(i) & ":" & Range(Adress(i + 1)).Offset(-1, 0).Address & ")")
        Next i
        End Sub
        0
      3. Arf !
        0
      4. Modérateur
        @ThauThemeArf??

        Je suis sur que l'on peut encore trouver d'autres façons de faire. Non?
        0
      5. @pijakuArf = étonnement admiratif..

        Oui il en existe sûrement d'autres...
        0