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
|
Sub Macro()
Dim TheCell As Range, TheCellFindX As Range, TheCellFindY As Range, TheResultat As Range
Dim NLigne As Integer, NCol As Integer
Dim value As Double
'On boucle sur le contenu de la colonne A
For Each TheCell In Sheets("Data").Range("A2", Sheets("Data").Cells(Rows.Count, "A").End(xlUp))
'On recherche la veleur dans la colonne A de la feuille 2
Set TheCellFindY = Sheets("Resultat").Columns("A").Find(TheCell, , , xlWhole, xlByColumns, , True, True)
'On regarde si une valeur a ete trouvée
If TheCellFindY Is Nothing Then 'Pas trouvé
'On selectionne une cellule vide a la suite et On ajoute la valeur dans le tableau Feuille2
Set TheCellFindY = Sheets("Resultat").Cells(Rows.Count, "A").End(xlUp).Offset(1)
TheCellFindY = TheCell
End If
'On cherche la valeur colonne B
Set TheCellFindX = Sheets("Resultat").Rows(1).Find(TheCell.Offset(0, 1), , , xlWhole, xlByColumns, , True, True)
'On regarde si valeur trouvée
If TheCellFindX Is Nothing Then 'Pas trouvé
'On pointe sur une nouvelle cellule et on ajoute la nouvelle valeur dans le tableau Feuille2
Set TheCellFindX = Sheets("Resultat").Cells(1, Columns.Count).End(xlToLeft).Offset(0, 1)
TheCellFindX = TheCell.Offset(0, 1)
End If
'Arrivé ici, TheCellFindx pointe dans tous les cas la bonne cellule de la ligne 1 du tableau FEuille2
'et TheCellFindY pointe la bonne cellule de la colonne A
'Il ne reste plus qu'a cocher l'intersection des 2
SommeProd = Evaluate("sumproduct((COUNTIF($A2;Data!$B$3:$B$65500)=1)*(COUNTIF(B$2;Data!$A$3:$A$65500)=1)*Data!$C$2:$C$65500)")
If IsNumeric(SommeProd) Then value = value + SommeProd
Sheets("Resultat").Cells(TheCellFindY.Row, TheCellFindX.Column) = value
Next
'On vide les variables objet
Set TheCellFindY = Nothing
Set TheCellFindX = Nothing
Set TheCell = Nothing
End Sub |
