Somme avec condition vba [Résolu]

[Maxgad]

Bonjour tout le monde,
Je suis entrain de finaliser un code vba, et j'aurais besoin d'un coup de pouce.
suivant le fichier joint, pourriez vous m'aider à faire la somme de la colonne "V" si la colonne "A" reste inchangée. et inscrire le total dans une autre feuille en Range("A1").
schéma
"A" "V"
300007 2522222
300007 3665552
300007 35522222
Total
300031 6666666
300031 5555555
total

Merci infiniment

[mercatog]

Utilise SOUS.TOTAL offert par excel

[Maxgad]

Merci mais Ca ne résout pas mon problème. Ca c est juste un bout de code d'une macro qui traite pas mal d'informations. Il me le faut absolument en vba si vous pouvez bien
Amicalement

[gFZT82]

Bonjour,

Voici une solution avec VBA.
Le récapitulatif, les sous-totaux et le total général sont notés dans la feuille « recap ».
J’ai supposé que ta liste était déjà triée.

Code :

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
30
31
Option Explicit
Sub Total()
Dim DerLig As Long, LigneAjout As Long, i As Long, Valeur As Long
Dim var1 As Single, var2 As Single
Dim Compteur As Double
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
 
    Set Ws1 = Worksheets("psa40276")
    Set Ws2 = Worksheets("Recap")
    DerLig = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row
    LigneAjout = 1
 
    Ws2.Range("A:B").ClearContents
    For i = 1 To DerLig
        Compteur = Compteur + Ws1.Range("V" & i).Value
        var1 = Ws1.Range("A" & i).Value
        var2 = Ws1.Range("A" & i).Offset(1, 0).Value
        If var2 <> var1 Then
            Ws2.Range("A" & LigneAjout) = var1
            Ws2.Range("B" & LigneAjout) = Compteur
            Compteur = 0
            LigneAjout = LigneAjout + 1
        End If
    Next i
    Ws2.Range("A" & LigneAjout) = "Total"
    Ws2.Range("B" & LigneAjout) = Application.WorksheetFunction.Sum(Ws2.Range("B1:B" & LigneAjout))
 
    Set Ws1 = Nothing
    Set Ws2 = Nothing
End Sub

Cordialement .

[mercatog]

Sous.Total d'Excel appliqué en vba sur ton fichier (Si le fichier comportait les titres en ligne 1, ça serait encore plus facile)

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Test()
 
Application.ScreenUpdating = False
With Worksheets("psa40276")
    'on enlève l'éventuel sous total
    .UsedRange.RemoveSubtotal
    'on insère les titres de colonnes
    .Rows(1).Insert
    .Range("A1:AD1").Value = "X"
    'Appliquer le sous total
    .UsedRange.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    'on supprime la première ligne ajoutée des titres
    .Rows(1).Delete
End With
End Sub

[Maxgad]

Bonsoir,
Merci bcp les gras, vos macro marchent à merveille.
Il n’y a plus qu'a choisir
Bonne soirée.