VBA - Somme de plusieurs cellules
Bonjour,
Je commence mon apprentissage dans la programmation de macros sous Excel 2010.
J'ai un petit souci sur la macro que j'ai écrit :
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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
| Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Suspension temporaires pour la macro
Application.ScreenUpdating = False
'Déclaration des variables
Dim TempColl() As String
Dim Test As Range
Dim ChekCell As String
Dim Cellule As Range
Dim CollNames() As String
Dim a As Integer
' ****** Programme Principal ******
a = 0
ChekCell = ""
Oldchek = ""
' ==== Etape 1 : Récupérer valeurs uniques
If (Sh.Name <> "== RECAP ==") Then
For Each Sh In ThisWorkbook.Worksheets
If (Sh.Name <> "== RECAP ==") And (Sh.Range("F2").Value = "Liste Complète") Then
For Each Cellule In Sh.Range("A2:A50")
If Not (IsError(Cellule.Value)) And (Oldchek <> Cellule.Value) Then
If (InStr(1, ChekCell, Cellule.Value) = 0) Then
If (a > 0) Then ChekCell = ChekCell + "-"
'TempColl(a, 1) = Cellule.Value
ChekCell = ChekCell + Cellule.Value
Oldchek = Cellule.Value
a = a + 1
End If
End If
Next Cellule
End If
Next Sh
CollNames = Split(ChekCell, "-")
' ==== Etape 2 : Affichage liste
cc = 0
For zz = 0 To UBound(CollNames)
If (CollNames(zz) <> "AUTRES BANDES") Then
Sheets("== RECAP ==").Range("A22").Offset(cc, 0).Clear
Sheets("== RECAP ==").Range("A22").Offset(cc, 0) = CollNames(zz)
cc = cc + 1
End If
Next zz
Sheets("== RECAP ==").Range("A22").Offset(cc + 1, 0).Clear
Sheets("== RECAP ==").Range("A22").Offset(cc + 1, 0) = "AUTRES BANDES"
' ==== Etape 3 : Tri ordre alphabétique
Range("A22").Select
ActiveWorkbook.Worksheets("== RECAP ==").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("== RECAP ==").Sort.SortFields.Add Key:=Range( _
"A22"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("== RECAP ==").Sort
.SetRange Range(ActiveCell, ActiveCell.Offset(UBound(CollNames) - 1, 0))
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' ==== Etape 4 : Affichage de résultats
lt = UBound(CollNames) - 1
For bb = 0 To lt
Sheets("== RECAP ==").Range("B22").Offset(bb, 0).Clear
Sheets("== RECAP ==").Range("B22").Offset(bb, 0).FormulaR1C1 = "=MultiSheets_Find(RC[-1])"
Next bb
Sheets("== RECAP ==").Range("B22").Offset(bb + 1, 0).Clear
Sheets("== RECAP ==").Range("B22").Offset(bb + 1, 0).FormulaR1C1 = "=MultiSheets_Find(RC[-1])"
Sheets("== RECAP ==").Range("A22").Offset(bb + 3, 0) = "TOTAL"
'--- Ici pour afficher la somme des cellules en RANGE ("B22").Offset(bb+3, 0) ----
End If
'Réactivation pour la macro
Application.ScreenUpdating = True
End Sub |
Mon problème est simple : Comment faire pour afficher la sommes des cellules entre B22 et (B22 + lt + 1), puisque la plage de cellule à additionner est dynamique ?
Je profite de ce message pour vous demander si vous voyez des optimisations à faire sur mon code.
A noter que la formule MultiSheets_find est une fonction que j'ai programmé. En voici le code :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
| Public Function MultiSheets_Find(A_Chercher As String)
Dim Sh As Worksheet
Dim Cellule As Range
Dim occurrence As Integer
occurrence = 0
For Each Sh In ThisWorkbook.Worksheets
If (Sh.Name <> "== RECAP ==") Then
For Each Cellule In Sh.Range("A2:A40")
If Not (IsError(Cellule.Value)) Then
If (Cellule.Value = A_Chercher) Then
occurrence = occurrence + 1
End If
End If
Next Cellule
End If
Next Sh
MultiSheets_Find = occurrence
End Function |
Merci d'avance de vos remarques et de votre aide,
Cordialement :)
