Macro pour somme dans première cellule vide

Aud1591 -  
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   -
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 :)
A voir également:

2 réponses

ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160
 
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
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160
 
Bonjour Pikaju,

On n'excuse pas l'incruste... On l'apprécie !
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761 > ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention  
 
Salut 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
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160
 
Arf !
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761 > ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention  
 
Arf??

Je suis sur que l'on peut encore trouver d'autres façons de faire. Non?
0
ThauTheme Messages postés 1442 Date d'inscription   Statut Membre Dernière intervention   160 > pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention  
 
Arf = étonnement admiratif..

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