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