nouvelle base

Option Explicit
Option Base 0

Function calculEssai(dd As Range)
Dim lPlg As Range, lCel As Range, sCel As Range, r()
    ReDim r(4, 9, 9)
    With dd.CurrentRegion
        For Each lPlg In .Resize(.Rows.Count - 1, .Columns.Count).Rows
            For Each lCel In lPlg.Cells
                On Error Resume Next 'Pour le cas où des données parasites (comme du texte, par exemple) se trouvent par mégarde dans la plage de données.
                For Each sCel In lPlg.Offset(1).Cells
                    If lCel.Value \ 10 = sCel.Value \ 10 Then r(lCel.Value \ 10, lCel.Value Mod 10, sCel.Value Mod 10) = 1 + r(lCel.Value \ 10, lCel.Value Mod 10, sCel.Value Mod 10)
                Next
                On Error GoTo 0
            Next
        Next
    End With
    calculEssai = r
End Function

Option Explicit

Sub essai()
Dim i&, j&, k&, r(), s()
    r = calculEssai([B3])
'Affichage du résultat :
    For i = 0 To UBound(r, 1) 'Un peu compliqué par le fait que le premier tableau de sortie n'a pas les mêmes dimensons que les suivants.
        ReDim s(-(i = 0) To 9, -(i = 0) To 9)
        For j = -(i = 0) To 9: For k = -(i = 0) To 9: s(j, k) = r(i, j, k): Next: Next
        [O2].Offset(12 * i + (i > 0)).Resize(10 + (i = 0), 10 + (i = 0)).Value = s '(à moins que Transpose(s) soit plus judicieux ? )
    Next i
End Sub