Option Explicit
Option Base 1
 
Public Function FrogMatrix(ByVal lSize&) As Long()
Dim lTempArr&()
Dim lSum&, lRepeat&
Dim lCol&, lRow&
    If lSize& > 0 Then
        ReDim lTempArr&(lSize&, lSize&)
        For lCol& = 0 To (lSize& - 1)
            lTempArr&(1, (lCol& + 1)) = lCol&
        Next lCol&
        lRepeat& = 1
        For lRow& = 2 To lSize&
            For lCol& = 1 To lSize&
                lSum& = FrogSum&(lTempArr&(), (lRow& - 1), lCol&, lRepeat&, lSize&)
                lTempArr&(lRow&, lCol&) = IIf((lSum& > 0), lSum&, lTempArr&((lRow& - 1), lCol&))
            Next lCol&
            lRepeat& = lRepeat& + 1
        Next lRow&
        FrogMatrix = lTempArr&()
    End If
End Function
 
Private Function FrogSum&(ByRef lArray&(), ByVal lRow&, ByVal lCol&, ByVal lRepeat&, ByVal lLimit&)
Dim Q&
    If Not (lCol& + lRepeat& > lLimit&) Then
        For Q& = 0 To lRepeat&
            FrogSum& = FrogSum& + lArray&(lRow&, lCol& + Q&)
        Next Q&
    End If
End Function
 
' º Un ejemplo :

Private Sub Form_Load()
Const vbBigSpace$ = "    "
Dim x&, y&
Dim sRow$
Dim lSize&
 
    lSize& = 10
 
    For x& = 1 To lSize&
        For y& = 1 To lSize&
            sRow$ = sRow$ & FrogMatrix(lSize)(x&, y&) & vbBigSpace$
        Next y&
 
        Debug.Print sRow$
        sRow$ = vbNullString
    Next x&
End Sub

 
Option Explicit
 
Private Declare Sub RtlMoveMemory Lib "kernel32" (pDst As Any, pSrc As Any, ByVal ByteLen As Long)
 
Private Function CreateMatriXBZeroX(ByVal vNum&, ByRef OutArray&()) As Boolean
Dim lng_f&, lng_c&, lng_fa&
 
    CreateMatriXBZeroX = vNum& > 0 And vNum& < 18
 
    If CreateMatriXBZeroX Then
        vNum& = vNum& - 1
        ReDim OutArray&(0 To vNum&, 0 To vNum&)
        For lng_f& = 0 To vNum&
            OutArray&(lng_f&, lng_c&) = lng_f&
        Next
        For lng_c& = 1 To vNum&
            For lng_f& = 0 To vNum& - lng_c&
                For lng_fa& = lng_f& To lng_c& + lng_f&
                    OutArray&(lng_f&, lng_c&) = OutArray&(lng_f&, lng_c&) + OutArray&(lng_fa&, lng_c& - 1)
                Next
            Next
            RtlMoveMemory ByVal VarPtr(OutArray&(lng_f&, lng_c&)), ByVal VarPtr(OutArray&(lng_f&, lng_c& - 1)), 4 * lng_c&
        Next
    End If
End Function
 
 

 
Private Sub Form_Load()
Dim OutArray&()
Dim lng_f&, lng_c&, lng_vNum&
    lng_vNum& = 5
    If CreateMatriXBZeroX(lng_vNum&, OutArray&) Then
        For lng_f& = 0 To lng_vNum& - 1
            For lng_c& = 0 To lng_vNum& - 1
                Debug.Print OutArray&(lng_c&, lng_f&),
            Next
            Debug.Print
        Next
    End If
End Sub
 
 

Private tmr As CTiming
 
 
Private Function MatriX7913(ByVal N As Integer) As Long()
    Dim M() As Long
    Dim x As Integer, y As Integer, Z As Integer
    Dim AGRUP As Long, TAM As Integer
 
    If N < 1 Then Exit Function
 
    TAM = N - 1
 
    ReDim M(TAM, TAM)
 
    For x = 0 To TAM
        M(x, 0) = x
        M(TAM, x) = TAM
        If TAM > 0 Then
            If Not x = TAM Then
                M(x, 1) = 1 + (x * 2)
                If x = TAM - 2 Then
                    For a = 1 To TAM
                        M(TAM - 1, a) = (TAM * 2) - 1
                    Next
                End If
            End If
        End If
   Next
If TAM > 1 Then
'GRACIAS LEANDRO A
    For y = 2 To TAM
        For x = 0 To (TAM - 2)
            If x + y > TAM Then
                M(x, y) = M(x, y - 1)
            Else
                AGRUP = 0
                For Z = x To y + x
                    AGRUP = AGRUP + M(Z, y - 1)
                Next
                M(x, y) = AGRUP
            End If
        Next
    Next
'GRACIAS LEANDRO A
End If
    MatriX7913 = M
 
End Function
 
Private Sub Form_Load()
  Dim M() As Long
  Dim TAMX As Integer, x As Integer, y As Integer
  Set tmr = New CTiming
 
  TAMX = 17
  For FAF = 1 To 10
  tmr.Reset
  M = MatriX7913(TAMX)
  MsgBox tmr.sElapsed
  Next
  For y = 0 To TAMX - 1
        For x = 0 To TAMX - 1
            Debug.Print M(x, y),
        Next
        Debug.Print
  Next
 
End Sub