Regroupement de cellules et calcul

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Mimosa777

XLDnaute Nouveau
Bonjour a tous,

voulant tout simplement eviter les tableaux croisés dynamiques, je désire faire un calcul qui me permettrait de regrouper plusieurs lignes dans une feuille de calcul contenant la meme valeur dans un champ en particulier et faire la somme du contenu des restes des cellules de cette meme ligne.

Mon code fonctionne presque parfait mais je n'arrive pas a trouver le petit probleme qui foire le calcul a un moment donné.

Voici mon tableau de donné de depart:
projet|cout|amortissement|type
projetA|125|25|N
projetA|126|35|N
projetA|127|45|N
projetA|128|55|D
projetB|129|65|D
projetC|130|75|F
projetC|131|85|F
projetC|132|95|F

et voici le resultat souhaité :
projetA|378|105|N
projetA|128|55|D
projetB|129|65|D
projetC|393|255|F

mais voici ce qu'il me retourne grace a mon code :
projetA|506|160|D
projetB|129|65|D
projetC|393|255|F

Vous remarquerez qu'il calcul la 4eme ligne (projet A) avec les N et remplace le N par un D. Ca me rend dingue, je comrpends pas pourquoi et j'ai tout essayer.

Voici ma macro :
Code:
Sub test()
Dim i As Integer, r As Integer
Sheet3.Range("A2:E65535").ClearContents
For i = 2 To Sheet2.Cells(Rows.Count, 1).End(xlUp).Row
        If Sheet2.Cells(i, 4) = "N" Then
            If Sheet2.Cells(i, 1) <> Sheet2.Cells(i - 1, 1) Then
                r = Sheet3.Cells(Rows.Count, 1).End(xlUp)(2).Row
                Sheet3.Cells(r, 1) = Sheet2.Cells(i, 1)
                Sheet3.Cells(r, 2) = Sheet2.Cells(i, 2)
                Sheet3.Cells(r, 3) = Sheet2.Cells(i, 3)
                Sheet3.Cells(r, 4) = Sheet2.Cells(i, 4)
            Else
                Sheet3.Cells(r, 1) = Sheet2.Cells(i, 1)
                Sheet3.Cells(r, 2) = Sheet3.Cells(r, 2) + Sheet2.Cells(i, 2)
                Sheet3.Cells(r, 3) = Sheet3.Cells(r, 3) + Sheet2.Cells(i, 3)
                Sheet3.Cells(r, 4) = Sheet2.Cells(i, 4)
            End If
        ElseIf Sheet2.Cells(i, 4) = "D" Then
            If Sheet2.Cells(i, 1) <> Sheet2.Cells(i - 1, 1) Then
                r = Sheet3.Cells(Rows.Count, 1).End(xlUp)(2).Row
                Sheet3.Cells(r, 1) = Sheet2.Cells(i, 1)
                Sheet3.Cells(r, 2) = Sheet2.Cells(i, 2)
                Sheet3.Cells(r, 3) = Sheet2.Cells(i, 3)
                Sheet3.Cells(r, 4) = Sheet2.Cells(i, 4)
            Else
                Sheet3.Cells(r, 1) = Sheet2.Cells(i, 1)
                Sheet3.Cells(r, 2) = Sheet3.Cells(r, 2) + Sheet2.Cells(i, 2)
                Sheet3.Cells(r, 3) = Sheet3.Cells(r, 3) + Sheet2.Cells(i, 3)
                Sheet3.Cells(r, 4) = Sheet2.Cells(i, 4)
            End If
        ElseIf Sheet2.Cells(i, 4) = "F" Then
            If Sheet2.Cells(i, 1) <> Sheet2.Cells(i - 1, 1) Then
                r = Sheet3.Cells(Rows.Count, 1).End(xlUp)(2).Row
                Sheet3.Cells(r, 1) = Sheet2.Cells(i, 1)
                Sheet3.Cells(r, 2) = Sheet2.Cells(i, 2)
                Sheet3.Cells(r, 3) = Sheet2.Cells(i, 3)
                Sheet3.Cells(r, 4) = Sheet2.Cells(i, 4)
            Else
                Sheet3.Cells(r, 1) = Sheet2.Cells(i, 1)
                Sheet3.Cells(r, 2) = Sheet3.Cells(r, 2) + Sheet2.Cells(i, 2)
                Sheet3.Cells(r, 3) = Sheet3.Cells(r, 3) + Sheet2.Cells(i, 3)
                Sheet3.Cells(r, 4) = Sheet2.Cells(i, 4)
            End If
            End If
             
Next
 
End Sub
Votre aide sera très apprécié. Merci d'avance.
 
Re : Regroupement de cellules et calcul

Bonjour mimosa,
Pas étudié votre code en détail, mais une chose me saute aux yeux : les lignes qui définissent r devraient être placées avant les lignes If...Then qui actuellement les précèdent.
A+
 
Re : Regroupement de cellules et calcul

Merci de votre aide mais j'ai trouver une autre solution que je mets pour ceux a qui cela interesserait un jour :
Code:
Sub traitement()
    Dim i, j As Integer
    Dim typeProjet, typeLettre As String
    'Call triDonnees
    i = 1
    j = 1
    typeProjet = ""
    typeLettre = ""
    While Trim(Sheets("Sheet2").Cells(i, 1).Value) <> ""
        If typeProjet <> Sheets("Sheet2").Cells(i, 1).Value Or typeLettre <> Sheets("Sheet2").Cells(i, 4).Value Then
            Sheets("Sheet3").Cells(j, 1).Value = Sheets("Sheet2").Cells(i, 1).Value
            Sheets("Sheet3").Cells(j, 2).Value = Sheets("Sheet2").Cells(i, 2).Value
            Sheets("Sheet3").Cells(j, 3).Value = Sheets("Sheet2").Cells(i, 3).Value
            Sheets("Sheet3").Cells(j, 4).Value = Sheets("Sheet2").Cells(i, 4).Value
            typeProjet = Sheets("Sheet2").Cells(i, 1).Value
            typeLettre = Sheets("Sheet2").Cells(i, 4).Value
            j = j + 1
        Else
            Sheets("Sheet3").Cells(j - 1, 2).Value = Sheets("Sheet3").Cells(j - 1, 2).Value + Sheets("Sheet2").Cells(i, 2).Value
            Sheets("Sheet3").Cells(j - 1, 3).Value = Sheets("Sheet3").Cells(j - 1, 3).Value + Sheets("Sheet2").Cells(i, 3).Value
        End If
        i = i + 1
    Wend
End Sub
😀
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
467
Réponses
2
Affichages
201
Réponses
4
Affichages
177
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
  • Question Question
XL 2021 VBA excel
Réponses
4
Affichages
169
Réponses
4
Affichages
534
Retour