Additionner les cellules par valeur identique

**marseille13** · 22/11/2019, 21h37

Bonjour a tous,

j'ai un sérieux problème de programmation d'ont je ne maîtrise pas encore

en effet j'ai un fichier de données de colonne A à colonne R
1 - je souhaite additionner les valeur de O P Q R et afficher les sommes dans les colonnes S T U V mais la condition est:
Colonne A = valeur identique
colonne D = valeur identique
Colonne N = valeur différentes
S = SOMME(O)
T = SOMME(P)
U = SOMME(Q)
V = SOMME(R)

2 - en suite je souhaite additionner les valeurs des colonnes S T U V et afficher les sommes dans les colonne W X Y Z
mais la condition est:

colonne D = valeur identique
colonne N = valeur différentes

W = SOMME (S)
X = SOMME(T)
Y = SOMME(U)
Z = SOMME(V)

je vous met l’exemple le résultat que je souhaite obtenir dans la Pièce Jointe ci dessous
il faut le faire en VBA pas ne formule car dans le fichier j'ai au moins 500 lignes a traiter

je vous remercie d'avance pour votre aide car c un peu urgent c un travail que je dois finir avant mercredi
CALCUL.xlsx

**ARTURO83** · 23/11/2019, 11h56

Bonjour,

Tout d'abord, pour ce qui n'ouvrent pas les fichiers joints et qui auraient de meilleures idées, un aperçu du fichier.
Pièce jointe 519234

Une première approche

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Sub Comptabiliser()
    Dim DerLig As Long, LigDep As Long
    Application.ScreenUpdating = False
 
    Columns("S:Z").ClearContents 'Effacements des résultats précédents
    Columns("S:Z").UnMerge 'Enlever les précédentes fusions de cellules
 
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
 
    '***********************************************************************************************************************
    'on fait un tri pour réunir les mêmes valeurs
    Columns("A:R").Select
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("A1:A" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("D1:D" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("N1:N" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("O1:O" & DerLig), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A1:R" & DerLig)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
    '***********************************************************************************************************************
    'Sommes des valeurs entre chaque ligne, si A,D sont égales et N différentes
    'Traitement colonne O, total en colonne S
    LigDep = 1
    For a = 1 To DerLig - 1
        If Cells(a, "A") = Cells(a + 1, "A") And Cells(a, "D") = Cells(a + 1, "D") And Cells(a, "N") <> Cells(a + 1, "N") And Cells(a, "O") <> Cells(a + 1, "O") Then
            Cells(LigDep, "S") = Cells(a, "O") + Cells(a + 1, "O")
            LigDep = a + 2
        End If
    Next a
 
    'Traitement colonne P, total en colonne T
    LigDep = 1
    For a = 1 To DerLig - 1
        If Cells(a, "A") = Cells(a + 1, "A") And Cells(a, "D") = Cells(a + 1, "D") And Cells(a, "N") <> Cells(a + 1, "N") And Cells(a, "P") <> Cells(a + 1, "P") Then
            Cells(LigDep, "T") = Cells(a, "P") + Cells(a + 1, "P")
            LigDep = a + 2
        End If
    Next a
 
    'Traitement colonne Q, total en colonne U
    LigDep = 1
    For a = 1 To DerLig - 1
        If Cells(a, "A") = Cells(a + 1, "A") And Cells(a, "D") = Cells(a + 1, "D") And Cells(a, "N") <> Cells(a + 1, "N") And Cells(a, "Q") <> Cells(a + 1, "Q") Then
            Cells(LigDep, "U") = Cells(a, "Q") + Cells(a + 1, "Q")
            LigDep = a + 2
        End If
    Next a
 
    'Traitement colonne R, total en colonne V
    LigDep = 1
    For a = 1 To DerLig - 1
        If Cells(a, "A") = Cells(a + 1, "A") And Cells(a, "D") = Cells(a + 1, "D") And Cells(a, "N") <> Cells(a + 1, "N") And Cells(a, "R") <> Cells(a + 1, "R") Then
            Cells(LigDep, "V") = Cells(a, "R") + Cells(a + 1, "R")
            LigDep = a + 2
        End If
    Next a
 
    '***********************************************************************************************************************
    'Somme en W,X,Y,Z
    Cells(1, "W") = Application.WorksheetFunction.Sum(Range(Cells(1, "S"), Cells(DerLig, "S")))
    Cells(1, "X") = Application.WorksheetFunction.Sum(Range(Cells(1, "T"), Cells(DerLig, "T")))
    Cells(1, "Y") = Application.WorksheetFunction.Sum(Range(Cells(1, "U"), Cells(DerLig, "U")))
    Cells(1, "Z") = Application.WorksheetFunction.Sum(Range(Cells(1, "V"), Cells(DerLig, "V")))
 
    '***********************************************************************************************************************
    'Fusion des cellules communes pour une meilleure lecture
    For j = 19 To 26
        DL = DerLig
        For i = DerLig To 1 Step -1
            If Cells(i, j) <> "" Then
                Range(Cells(i, j), Cells(DL, j)).Merge
                DL = i - 1
            End If
        Next i
    Next j
    With Columns("S:Z")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
End Sub

Le fichier
Pièce jointe 519233

Cdlt

**marseille13** · 23/11/2019, 12h42

Bonjour ARTURO83

tout d'abord merci beaucoup pour ton aide.

en effet le code donne les bon résultat avec le les lignes que j'ai données en exemple visuellement pas en calcul

Nom : Capture.JPG
Affichages : 928
Taille : 53,5 Ko

Nom : Capture.JPG
Affichages : 928
Taille : 53,5 Ko

En colonne S on voit bien que le 6 représente 3 ligne alors que c'est faux, il doit représenter deux ligne donc fusionner uniquement la ligne 2 et 3
ça sera la même chose en colonne T, U et V

enfin pour les colonnes W X Y Z
W = 52 pas 58 car la règle c'est qu'on calcul uniquement la somme si en colonne D la valeur est identique et en colonne N la valeur est différente
donc W = 45 + 7 = 52 et la fusion n'inclut pas les lignes 3, 2 et 1

ça sera la même chose pour les colonnes X, Y et 7

je te remercie d'avance pour ton aide

**ARTURO83** · 23/11/2019, 13h21

Pour pouvoir tester tous les cas de figures et pour éviter d'en fabriquer un qui risque de ne pas coller à la réalité, il serait souhaitable d'avoir un fichier avec plusieurs cas de figures et si possibles avec les résultats attendus.
Pour ajouter un fichier en pièce jointe, cliquez sur l'icone "Trombone" ci-dessus.

**marseille13** · 23/11/2019, 14h41

Envoyé par ARTURO83

Pour pouvoir tester tous les cas de figures et pour éviter d'en fabriquer un qui risque de ne pas coller à la réalité, il serait souhaitable d'avoir un fichier avec plusieurs cas de figures et si possibles avec les résultats attendus.
Pour ajouter un fichier en pièce jointe, cliquez sur l'icone "Trombone" ci-dessus.

le problème c'est que je peux pas donner le fichier car il y a des données sensibles il est uniquement sur mon poste de bureau. Si je change le moindre fichier dur internet ils le verrons. Toutes fois que je voudrai avoir c de prendre considération la colonne D et N pour calculer les colonnes W X Y Z.
Si dans D il y plus d'une valeur identiques successivement et que dans la même ligne dans la colonne N il y a différente valeur donc je fais l'addtion des valeurs de la colonne O de la même ligne que N puis j'affiche dans colonnes W ca sera la même règle pour X Y Z

**mercatog** · 23/11/2019, 14h55

Tu ne peux pas utiliser sous total fourni par excel si tes données sont triées bien sûr.
Le disposition sera autre mes les totaux seront mis en valeur

Additionner les cellules par valeur identique [XL-2016]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager