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