HOLA!!!
Me costo bastante, se que funciona , pero seguro es lentisima , tendria queaprovechar mas los bucles (Ya esta!), pero es un lio XD.
AGREGUE DECIMALES: Problema, hay que cargarlos por separado. XD sino tarda demasiado la funcion.
GRACIAS POR LEER!!!
Me costo bastante, se que funciona , pero seguro es lentisima , tendria que
AGREGUE DECIMALES: Problema, hay que cargarlos por separado. XD sino tarda demasiado la funcion.
Código (vb) [Seleccionar]
Private Function ZZ(n As Long, M() As Double, Optional DECIMALES As Double)
Dim x As Integer
Dim y As Integer
Dim SQ_Root As Integer
Dim ACUM As Double
Dim ACUM2 As Double
SQ_Root = Int(Sqr(n)) 'GRACIAS BLACK POR SQR
ReDim M(SQ_Root, SQ_Root + 1)
M(0, 1) = 1 '+ Dec_Part
ACUM = 0
ACUM2 = 0
For x = 1 To SQ_Root - 1 'PRIMERA LINEA Y PRIMERA COLUMNA
M(x, 1) = M(x - 1, 1) + x 'PRIMERA LINEA
M(0, x + 1) = M(0, x) + x + 1 'PRIMERA COLUMNA
ACUM = ACUM + M(0, x + 1)
ACUM2 = ACUM2 + M(x, 1)
Next
M(0, SQ_Root + 1) = ACUM + M(0, 1) 'TOTAL DE PRIMERA COLUMNA
M(SQ_Root, 1) = ACUM2 + M(0, 1) 'TOTAL DE PRIMERA FILA
ACUM = 0
ACUM2 = 0
For x = 1 To SQ_Root - 1 'ULTIMA LINEA Y ULTIMA COLUMNA
M(x, SQ_Root) = M(x - 1, SQ_Root) + SQ_Root - x 'ULTIMA LINEA
M(SQ_Root - 1, x + 1) = M(x - 1, SQ_Root) + 1 'ULTIMA COLUMNA
ACUM = ACUM + M(SQ_Root - 1, x + 1)
ACUM2 = ACUM2 + M(x, SQ_Root)
Next
M(SQ_Root - 1, SQ_Root + 1) = ACUM + M(SQ_Root - 1, 1) 'TOTAL DE ULTIMA COLUMNA
M(SQ_Root, SQ_Root) = ACUM2 + M(0, SQ_Root) 'TOTAL DE ULTIMA FILA
For y = 2 To SQ_Root - 1 'RELLENO (DEL CUADRO INTERIOR) Y TOTALES FILAS
ACUM = 0
For x = 1 To SQ_Root - 2
M(x, y) = 1 + M(x + 1, y - 1)
ACUM = ACUM + M(x, y)
Next
ACUM = ACUM + M(0, y) + M(SQ_Root - 1, y)
M(SQ_Root, y) = ACUM
Next
For x = 1 To SQ_Root - 2 'TOTALES COLUMNAS INTERNAS
ACUM = 0
For y = 1 To SQ_Root
ACUM = ACUM + M(x, y)
Next
M(x, SQ_Root + 1) = ACUM
Next
ACUM = 0
If DECIMALES <> 0 Then
For x = 0 To SQ_Root - 1
For y = 1 To SQ_Root
M(x, y) = M(x, y) + DECIMALES
Next
Next
DECIMALES = DECIMALES * SQ_Root
For x = 0 To SQ_Root
M(x, SQ_Root + 1) = M(x, SQ_Root + 1) + DECIMALES
M(SQ_Root, x + 1) = M(SQ_Root, x + 1) + DECIMALES
Next
End If
For x = 0 To SQ_Root - 1 'ESQUINAS
ACUM = ACUM + M(x, SQ_Root + 1)
Next
M(SQ_Root, SQ_Root + 1) = ACUM
M(SQ_Root, 0) = ACUM
For x = 0 To SQ_Root - 1 'PRIMERA LINEA RARA QUE NO TIENE SENTIDO
M(x, 0) = SQ_Root ^ 4 + M(x, SQ_Root + 1) + SQ_Root ^ 2
Next
ZZ = True
Exit Function
Err_:
ZZ = False
End Function
GRACIAS POR LEER!!!