Sub Stat2DTab()
Set f = Sheets("mb25_cutting_+_mb25_sewing")
TblBD = f.Range("A2:C" & f.[A65000].End(xlUp).Row).Value ' Array pour rapidité
colCrit1 = 1: colCrit2 = 2: colOper = 3
Set Result = f.Range("f1") ' Adresse résultat
Set d1 = CreateObject("Scripting.Dictionary") ' Dictionnaire index pour rapidité
Set d2 = CreateObject("Scripting.Dictionary")
Dim TblTot(): ReDim TblTot(1 To UBound(TblBD), 1 To UBound(TblBD, 2))
Dim TblTotLig(): ReDim TblTotLig(1 To UBound(TblBD))
Dim TblTotCol(): ReDim TblTotCol(1 To UBound(TblBD, 2))
For i = LBound(TblBD) To UBound(TblBD)
clé1 = TblBD(i, colCrit1): If d1.exists(clé1) Then lig = d1(clé1) Else d1(clé1) = d1.Count + 1: lig = d1.Count
clé2 = TblBD(i, colCrit2): If d2.exists(clé2) Then col = d2(clé2) Else d2(clé2) = d2.Count + 1: col = d2.Count
TblTot(lig, col) = TblTot(lig, col) + TblBD(i, colOper)
TblTotLig(lig) = TblTotLig(lig) + TblBD(i, colOper)
TblTotCol(col) = TblTotCol(col) + TblBD(i, colOper)
Next i
Result.Offset(1).Resize(d1.Count, 1) = Application.Transpose(d1.keys) ' titre lignes
Result.Offset(, 1).Resize(1, d2.Count) = d2.keys ' titres colonnes
Result.Offset(1, 1).Resize(d1.Count, d2.Count) = TblTot ' stat 2D
Result.Offset(d1.Count + 1, 1).Resize(, d2.Count) = TblTotCol ' totaux colonnes
Result.Offset(1, d2.Count + 1).Resize(d1.Count) = Application.Transpose(TblTotLig) ' totaux lignes
End Sub