Boucle pour sommer un tableau

**toty44** · 18/10/2011, 10h17

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 :

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
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** · 18/10/2011, 12h58

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** · 18/10/2011, 13h29

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** · 18/10/2011, 13h51

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 :

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

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 :

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

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** · 18/10/2011, 13h56

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** · 18/10/2011, 15h24

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

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
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.

**Didier Gonard** · 19/10/2011, 14h47

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** · 20/10/2011, 07h45

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