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
| Sub sub_macro()
Dim i As Long, LigFin As Long, j As Long
Dim fct As String, fct1 As String, fct2 As String, fct3 As String, fct4 As String
Dim pose()
LigFin = [AE65536].End(xlUp).Row
j = 1
For i = 3 To LigFin
fct = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AF$2))"
fct1 = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AG$2))"
fct2 = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AH$2))"
fct3 = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AI$2))"
fct4 = "=SUMPRODUCT($K$12:$K$2000*(($A$12:$A$2000)=" & Range("AE" & i).Address(False, True) & ")*(($G$12:$G$2000)=AJ$2))"
' Cells(i, 32) = Evaluate(fct)
'Cells(i, 33) = Evaluate(fct1)
'Cells(i, 34) = Evaluate(fct2)
'Cells(i, 35) = Evaluate(fct3)
'Cells(i, 36) = Evaluate(fct4)
' Range("AK" & i).Formula = "=" & Range("AF" & i).Address(False, True) & "+" & Range("AG" & i).Address(False, True) & "+" & Range("AH" & i).Address(False, True) & "+" & Range("AI" & i).Address(False, True) & "+" & Range("AJ" & i).Address(False, True) & ""
ReDim Preserve pose(1 To 6, 1 To j)
pose(1, j) = Evaluate(fct)
pose(2, j) = Evaluate(fct1)
pose(3, j) = Evaluate(fct2)
pose(4, j) = Evaluate(fct3)
pose(5, j) = Evaluate(fct4)
For t = 1 To 5
pose(6, j) = pose(6, j) + pose(t, j)
Next t
j = j + 1
Next i
Range("ae3:aj" & j + 1).Value = Application.WorksheetFunction.Transpose(pose)
End Sub |