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 InscrireValeurs()
Dim ShtS As Worksheet
Dim DLigS As Long
Dim ShtD As Worksheet
Dim Col As Long, DColD As Long, DLigD As Long, Lig As Long
Dim MaForm As String ' variable pour la Formule
Dim sCrit As String ' Variable pour le critère Cdt
' Définir la feuille source
Set ShtS = Worksheets("Feuil2")
' Récupérer le numéro de la dernière ligne remplie de la feuille
DLigS = ShtS.Range("A" & ShtS.Rows.Count).End(xlUp).Row
' Définir la feuille de destination
Set ShtD = Worksheets("Feuil1")
' Récupérer le numéro de la dernière colonne et dernière ligne
DColD = ShtD.Cells(1, ShtD.Columns.Count).End(xlToLeft).Column
DLigD = ShtD.Range("A" & ShtS.Rows.Count).End(xlUp).Row
' La formule matricielle
'=SOMMEPROD((Feuil2!$A$2:$A$14=$A2)*(Feuil2!$C$2:$C$14=C$1)*(Feuil2!$D$2:$D$14))
' *** PREMIERE POSSIBILITE (peut être supprimée)***
' Incrire la formule dans la première cellule
ShtD.Range("C2").FormulaLocal = _
"=SOMMEPROD((Feuil2!$A$2:$A$14=$A2)*(Feuil2!$C$2:$C$14=C$1)*(Feuil2!$D$2:$D$14))"
' Effectuer une recopie vers le bas
ShtD.Range("C2:C" & DLigD).FillDown
' Effectuer uen recopie vers la droite
ShtD.Range(ShtD.Cells(2, 3), ShtD.Cells(DLigD, DColD)).FillRight
' Copier / coller les valeurs
With ShtD.Range(ShtD.Cells(2, 3), ShtD.Cells(DLigD, DColD))
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
'
' *** DEUXIEME POSSIBILITE (peut être supprimée)***
' Ou effectuer le calcul pour chaque cellule du tableau
For Col = 3 To DColD
sCrit = ShtD.Cells(1, Col).Address
For Lig = 2 To DLigD
MaForm = "SUMPRODUCT((" & ShtS.Name & "!$A$2:$A$14=$A" & Lig & ")*(" _
& ShtS.Name & "!$C$2:$C$14=" & sCrit & ")*(" & ShtS.Name & "!$D$2:$D$14))"
ShtD.Cells(Lig, Col).Value = Application.Evaluate(MaForm)
Next Lig
Next Col
End Sub |
