Boucle pour sommer un tableau [Résolu]

[toty44]

Bonjour le forum

Je suis toute nouvelle (inscrite ce matin, il y a longtemps que j’y pense).

Je connais un peu VBA (un peu)

Dans le cadre de tableau de synthèse je récupère via Query des valeurs de notre ERP.
Ces valeurs ne sont pas sommées (Temps infernal).

Je fais donc une petite moulinette pour le faire

Que voici

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
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
Sub macro1()
' par Toty
 
'Déclaration des variables
Dim NbH As Single
Dim Cout As Single
Dim j As Long
Dim i As Long
 
With Sheets("base")
' Tri du résultat de la requête
    .Columns("A:F").Sort Key1:=.Range("B2"), Order1:=xlAscending, Key2:=.Range("C2"), Order2:=xlAscending, Key3:=.Range("D2"), Order3:=xlAscending, Header:=xlYes
 
' Comparaison des valeurs triées
' Si les valeurs de la lignes sont égales, on indique OUI sinon NON
    .Range("O2").FormulaR1C1 = "=If(And(RC[-13]=R[-1]C[-13],RC[-12]=R[-1]C[-12],RC[-11]=R[-1]C[-11]),""OUI"",""NON"")"
' Copie de la formule jusqu'a la denière ligne
.Range("O2").AutoFill Destination:=.Range("O2:O" & .Range("A65536").End(xlUp).Row)
' Copiage spécial pour ne récupérer que la valeur
    .Range("O2:O" & .Range("A65536").End(xlUp).Row).Copy
    .Range("O2:O" & .Range("A65536").End(xlUp).Row).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
' Mise en place des entêtes de colonne
    .Range("P1").Value = "Type"
    .Range("Q1").Value = "Reférence"
    .Range("R1").Value = "Client"
    .Range("S1").Value = "Secteur"
    .Range("T1").Value = "NbH"
    .Range("U1").Value = "Cout"
 
    NbH = .Range("E2").Value ' récupération de la premiére valeur de NbH
    Cout = .Range("F2").Value ' récupération de la premiére valeur de Cout
 
    j = 2
    For i = 2 To .Range("A65536").End(xlUp).Row + 1 ' Bouclage sur le tableau
        If .Range("O" & i).Value = "OUI" Then ' Si Oui
            NbH = NbH + .Range("E" & i).Value ' Somme des valeurs de NbH
            Cout = Cout + .Range("F" & i).Value ' Somme des valeur de Cout
        Else ' si NON récupération des valeurs sommées
            .Range("P" & j).Value = "P"
            .Range("Q" & j).Value = .Range("B" & i - 1).Value
            .Range("R" & j).Value = .Range("C" & i - 1).Value
            .Range("S" & j).Value = .Range("D" & i - 1).Value
            .Range("T" & j).Value = NbH
            .Range("U" & j).Value = Cout
 
            NbH = .Range("E" & i).Value ' récupération de la nouvelle valeur de NbH
            Cout = .Range("F" & i).Value ' récupération de la nouvelle valeur de Cout
            j = i
        End If
    Next i
 
' Tri du résultat sommé
    .Columns("P:U").Sort Key1:=.Range("Q2"), Order1:=xlAscending, Header:=xlYes
' Suppression du tableau
    .Columns("A:O").Delete Shift:=xlToLeft
End With
End Sub

J’aimerais savoir s’il n’y avait pas une manière plus rationnelle pour arriver le même résultat

Par avance merci

Toty

[Daniel.C]

Bonjour,

Plutôt que de poster ton code, décris plutôt la disposition de tes données et le résultat que tu désires.

[toty44]

Bonjour Daniel

Désolée, en fait je reçois un tableau qui occupe les colonnes A à F

La première n’a pas vraiment d’importance

Sur les 3 suivantes Les cellules peuvent être identiques sur différente lignes
Sur le 2 dernières j’ai des valeurs numériques

Le but est de sommer c’est deux dernières colonnes avec comme regroupement
Les valeurs des 3 colonnes qui peuvent contenir les valeurs identiques

En fait en SQL cela donnerait

« Select Rang, Type, Référence, client, secteur, sum(NhH), Sum(Cout) From LaBase Group BY Rang, Type, Référence, client, secteur »

Voila, j’espère avoir répondu à ta question

Merci

Toty

[Jean-Pierre49]

Re Bonjour Toty

Pourquoi ne pas l’inclure dans la requête d’origine

Pourquoi le collage spécial ?

Dans un premier temps
Tu peux aussi remplacer

Code :

1
2
3
4
' Si les valeurs de la lignes sont égales, on indique OUI sinon NON
    .Range("O2").FormulaR1C1 = "=If(And(RC[-13]=R[-1]C[-13],RC[-12]=R[-1]C[-12],RC[-11]=R[-1]C[-11]),""OUI"",""NON"")"
' Copie de la formule jusqu'a la denière ligne
    .Range("O2").AutoFill Destination:=.Range("O2:O" & .Range("A65536").End(xlUp).Row)

Par

Code :

1
2
' Si les valeurs de la lignes sont égales, on indique OUI sinon NON
    .Range("O2:O" & .Range("A65536").End(xlUp).Row).FormulaR1C1 = "=If(And(RC[-13]=R[-1]C[-13],RC[-12]=R[-1]C[-12],RC[-11]=R[-1]C[-11]),""OUI"",""NON"")"

Sinon, personnellement, sur le fond cela ne me parait pas mal

Bon Courage

[toty44]

Bonjour Jean Pierre

L’informaticien me dit que faire le regroupement lors de la requête mettrait un temps infernal compte tenu des bases, je n’ai pas accès à ces bases.

Alors j’ai fait cette moulinette et je voulais savoir s’il n’y avait pas plus simple

Il est vrai que le collage spécial n’est pas nécessairement utile

Et merci pour ta ligne de code


Toty

[mercatog]

Bonjour
Si j'ai bien compris, ci-joint une proposition en utilisant une variable tableau (à tester)

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
Sub macro1()
Dim LastLig As Long, i As Long
Dim S As Double, T As Double
Dim Doubl As Boolean
Dim Tb
 
Application.ScreenUpdating = False
With Sheets("base")
    .AutoFilterMode = False
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
    'Tri du résultat de la requête
    .Range("A1:F" & LastLig).Sort Key1:=.Range("B2"), Order1:=xlAscending, Key2:=.Range("C2"), Order2:=xlAscending, Key3:=.Range("D2"), Order3:=xlAscending, Header:=xlYes
    Tb = .Range("A1:F" & LastLig).Value
    For i = LastLig To 2 Step -1
        If Tb(i, 2) & "|" & Tb(i, 3) & "|" & Tb(i, 4) = Tb(i - 1, 2) & "|" & Tb(i - 1, 3) & "|" & Tb(i - 1, 4) Then
            Tb(i, 1) = Empty
            S = S + Tb(i, 5)
            T = T + Tb(i, 6)
            Doubl = True
        Else
            Tb(i, 1) = "P"
            Tb(i, 5) = IIf(Doubl, S, 0) + Tb(i, 5)
            Tb(i, 6) = IIf(Doubl, T, 0) + Tb(i, 6)
            S = 0: T = 0: Doubl = False
        End If
    Next i
    .Range("A1:F" & LastLig) = Tb
    .Range("A1:F1").Value = Array("Type", "Reférence", "Client", "Secteur", "NbH", "Cout")
    'éventuellement ici supprimer les lignes en double
End With
End Sub

Éventuellement on peut supprimer les lignes en double et en gardant seulement les lignes où on a écrit les sous totaux. Pour cela il suffit de filtrer la colonne A sur les cellules vides et supprimer les ligne visible et ne garder que les ligne contenant la ligne P en colonne A.

Une autre proposition, est de concaténer en G les colonnes B, C et D et d'utiliser le Sous total offert par Excel.
Bon, ce sont là des propositions.

[toty44]

Bonjour mercatog

Je vous remercie d’abord de votre réponse,

Au début j’ai eu peur

Mais avec F1 pour le IIf et un peu de réflexion
J’ai compris, je pense, le résonnement et le code
J’ai mis mes remarques dans votre code
Pouvez-vous me dire si j’ai tout saisie

Je me suis permise de modifier le code afin de ne faire ressortir que les lignes sommées

en supprimant

Code :

Tb(i, 1) = "P"

et en y rajoutant

Code :

1
2
3
            For j = 1 To 6 ' on efface la ligne
                Tb(i, j) = Empty
            Next j

Et d’y faire un tri en final

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
32
33
34
35
36
Sub macro1()
Dim LastLig As Long, i As Long
Dim S As Double, T As Double
Dim Doubl As Boolean
Dim Tb
 
Dim j As Byte
 
Application.ScreenUpdating = False ' Ok blocage de la mise à jour de l'écran
With Sheets("base")
    .AutoFilterMode = False ' Ok mais dans mon cas inutile, mais on ne sait jamais
    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row ' Pourquoi pas  LastLig = .Range("A1:A" & .Rows.Count).End(xlUp).Row 
 
    'Tri du résultat de la requête
    .Range("A1:F" & LastLig).Sort Key1:=.Range("B2"), Order1:=xlAscending, Key2:=.Range("C2"), Order2:=xlAscending, Key3:=.Range("D2"), Order3:=xlAscending, Header:=xlYes
    Tb = .Range("A1:F" & LastLig).Value ' Création du tableau
    For i = LastLig To 2 Step -1 ' On boucle par le bas
        If Tb(i, 2) & "|" & Tb(i, 3) & "|" & Tb(i, 4) = Tb(i - 1, 2) & "|" & Tb(i - 1, 3) & "|" & Tb(i - 1, 4) Then ' Test sur les valeurs des lignes pouvant être identiques
            S = S + Tb(i, 5) ' Somme de valeur de Nbh
            T = T + Tb(i, 6) ' Somme de valeur de Cout
            Doubl = True ' On met la variable Doubl à Vrai
            For j = 1 To 6 ' on efface la ligne
                Tb(i, j) = Empty
            Next j
        Else
            Tb(i, 5) = IIf(Doubl, S, 0) + Tb(i, 5) ' Si Doubl=Vrai on additionne la dernière valeur de Nbh à S si non on ne fait rien Nbh=Nbh
            Tb(i, 6) = IIf(Doubl, T, 0) + Tb(i, 6) ' Si Doubl=Vrai on additionne la dernière valeur de Cout à T si non on ne fait rien Cout=Cout
            S = 0: T = 0: Doubl = False ' Réinitialisation des variables
        End If
    Next i
    .Range("A1:F" & LastLig) = Tb ' Récupération du tableau dans la feuille
    .Range("A1:F1").Value = Array("Type", "Reférence", "Client", "Secteur", "NbH", "Cout") ' Création des entêtes de colonnes
    'On supprime les lignes vides
    .Columns("A:F").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes
End With
End Sub

A si encore si je peux me permettre

Code :

    LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row

Pourquoi pas

Code :

LastLig = .Range("A1:A" & .Rows.Count).End(xlUp).Row

Encore merci

Toty

[mercatog]

Bonjour
Tu as tout saisi très bien et même tu as perfectionnée la suppression des lignes. Bravo (au lieu de filtrer et supprimer, tu vide Tb est tu déplace les lignes vides en bas grâce au tri)

Pour trouver la ligne de la dernière cellule remplie, je te propos ce lien

Pour la ligne 34 de tri, personnellement je préfère faire comme ceci

Code :

.Range("A1:F" & LastLig).Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes

Attntion, tu as oublié un point juste avant Range("A2") faisant référence à ta feuille base.

[toty44]

Bonjour mercatog

Encore merci de vos remarques et du lien

Toty

[Ormonth]

Envoyé par toty44

Sur le 2 dernières j’ai des valeurs numériques

Le but est de sommer c’est deux dernières colonnes avec comme regroupement
Les valeurs des 3 colonnes qui peuvent contenir les valeurs identiques

.../...
J’aimerais savoir s’il n’y avait pas une manière plus rationnelle pour arriver le même résultat

Tu as essayé avec un TCD (Tableau Croisé Dynamique) ?

ça me semble être furieusement la cible et en 3 clics, c'est fait et ça se modifie aussi vite.

Si besoin, on peut le faire ( le TCD) en VBA mais bon...

à préciser ta version d'Excel, c'est très différent de 2003 à 2010, mais de base ce type d'application est OK. C'est très adapté à des sources SQL en plus.
Sous 2010 les possibilités sont 100uplées

cordialement,

Didier

[toty44]

Bonjour Ormonth

Je sais que le tableau croisé dynamique est tout à fait adapté pour cela, mes collèges l’utilise, mais moi je préférais le faire comme ça.
(version Excel 2003)

Et puis je n’aurais eu le plaisir de réfléchir sur le code de mecatog

Je dois vous quitter (les chantiers n’attendent pas)

Au plaisir et bonne journée

Toty

[Ormonth]

Bonjour,

c'était juste pour être rationnel ...

Envoyé par toty44

J’aimerais savoir s’il n’y avait pas une manière plus rationnelle pour arriver le même résultat

cordialement,

Didier