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
| Sub Sakarov()
Dim TheCel As Range
Dim FirstCel As Range
Dim TheSh As Worksheet
Dim LFirstCel As Long, LLastCel As Long
'Initialisation de variables
Set TheSh = Sheets("Feuil1")
With TheSh 'permet de ne pas avoir a répeter TheSh a chaque fois, si vba rencontre un . il rajouetra TheSh devant
'On marque la cellule A2 comme etant la 1ere de la serie
Set FirstCel = .Range("A2")
Do
'On boucle de la cellule FirstCel+1ligne jusqu'a la derniere cellule non vide du tableau (+1 ligne qui servira a finir la boucle Do car elle sera vide)
For Each TheCel In .Range(FirstCel.Offset(1, 0), .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0))
'On regarde si le contenu des 2 cellules est différent
If FirstCel.Value <> TheCel.Value Then
'TheCel represente une cellule contenant une valeur differente
'On memorise les lignes de la 1ere et derniere ligne
LFirstCel = FirstCel.Row
'On utilise donc la ligne superieur (offset(-1,...)) qui correspond a al derniere ligne contenant la mm valeur que FirstCel
LLastCel = TheCel.Offset(-1, 0).Row
'Et on met la somme dans la colonne L (offset(-1,11))
TheCel.Offset(-1, 11).Value = WorksheetFunction.SumProduct(.Range(.Cells(LFirstCel, "J"), .Cells(LLastCel, "J")), .Range(.Cells(LFirstCel, "E"), .Cells(LLastCel, "E"))) / WorksheetFunction.SumProduct(.Range(.Cells(LFirstCel, "K"), .Cells(LLastCel, "K")), .Range(.Cells(LFirstCel, "E"), .Cells(LLastCel, "E")))
'Placer une formule au lieu de lla valeur (en colone M ici (offset(..,12)))
TheCel.Offset(-1, 12).Formula = "=SumProduct(" & .Range(.Cells(LFirstCel, "J"), .Cells(LLastCel, "J")).Address & "," & .Range(.Cells(LFirstCel, "E"), .Cells(LLastCel, "E")).Address & ")/ SumProduct(" & .Range(.Cells(LFirstCel, "K"), .Cells(LLastCel, "K")).Address & "," & .Range(.Cells(LFirstCel, "E"), .Cells(LLastCel, "E")).Address & ")"
'On quitte cette boucle
Exit For
End If
'Si les 2 cellules sont identiques, on continue la boucle
Next TheCel
'Ensuite Fisrtcel devent donc La cellule pointé pas TheCel
Set FirstCel = TheCel
'On retourne a Do jusqu'a ce que FirstCel soit vide
Loop Until FirstCel.Value = ""
End With
End Sub |
