Mostrar Mensajes
Código:
Option Explicit
'modKrabby
'modulo bas
Public Function Krabby_ZigZag(Numero As Long) As Boolean
Dim Columnas As Long, Filas As Long
Dim NumeroValido As Long
Dim Num As Long, Base As Long
Dim MyX As Long, MyY As Long
Dim CeldaAbajoLibre As Long
Dim Celda() As Long, Resto As Long
Dim cadena As String
'variables destino
Dim FilasDestino As Long, ColumnasDestino As Long
Dim BaseDestino As Long
Dim CeldaDestino() As Long
Dim Suma As Long
Dim SumaUltimaFila As Long
NumeroValido = Int(Sqr(Numero)) * Int(Sqr(Numero))
Columnas = Int(Sqr(Numero))
Filas = Int(Sqr(Numero))
ReDim Celda(1 To NumeroValido) As Long
Dim X As Long, Y As Long
For X = 1 To Columnas
MyY = 1
MyX = X
CeldaAbajoLibre = X
Num = Num + 1
Base = (MyY - 1) * Columnas
Celda(Base + MyX) = Num
If CeldaAbajoLibre > 1 Then
For Y = 1 To CeldaAbajoLibre - 1
MyX = MyX - 1
Num = Num + 1
MyY = MyY + 1
Base = (MyY - 1) * Columnas
Celda(Base + MyX) = Num
Next Y
End If
Next X
Resto = Columnas - 1
Dim MyY2 As Long
MyY = 1
For X = Resto To 1 Step -1
MyY = MyY + 1
MyX = Columnas
MyY2 = MyY
CeldaAbajoLibre = X
Num = Num + 1
Base = (MyY2 - 1) * Columnas
Celda(Base + MyX) = Num
If CeldaAbajoLibre > 1 Then
For Y = 1 To CeldaAbajoLibre - 1
MyX = MyX - 1
Num = Num + 1
MyY2 = MyY2 + 1
Base = (MyY2 - 1) * Columnas
Celda(Base + MyX) = Num
Next Y
End If
Next X
'imprime
For X = 1 To Columnas
Base = (X - 1) * Columnas
For Y = Base + 1 To Base + Columnas
cadena = cadena & Celda(Y) & " "
Next Y
cadena = cadena & vbCrLf
Next X
Debug.Print cadena
'Open "c:\aa.txt" For Append As #1
'Print #1, cadena
'Print #1, extra
'Close #1
'pasa los numero a la celda destino
FilasDestino = Filas + 1 '1ra fila de sumar
FilasDestino = FilasDestino + 1 'ultima fila de sumas
ColumnasDestino = Columnas + 1 'ultima columna de sumas
ReDim CeldaDestino(1 To (FilasDestino * ColumnasDestino)) As Long
For X = 1 To Filas
For Y = 1 To Columnas
Base = (X - 1) * Columnas
BaseDestino = (X) * ColumnasDestino
CeldaDestino(BaseDestino + Y) = Celda(Base + Y)
Suma = Suma + CeldaDestino(BaseDestino + Y)
Next Y
CeldaDestino(BaseDestino + ColumnasDestino) = Suma
Suma = 0
Next X
'**************************************
'ultimo agregado (codigo perdido)
For X = 1 To ColumnasDestino - 1
For Y = 2 To FilasDestino - 1
BaseDestino = (Y - 1) * ColumnasDestino
Suma = Suma + CeldaDestino(BaseDestino + X)
Next Y
BaseDestino = (FilasDestino - 1) * ColumnasDestino
CeldaDestino(BaseDestino + X) = Suma
Suma = 0
Next X
'************************************
'ultimo codigo agregado al final
'*****************************************
'suma de la ultima fila
For X = 1 To ColumnasDestino - 1
BaseDestino = (FilasDestino - 1) * ColumnasDestino
Suma = Suma + CeldaDestino(BaseDestino + X)
Next X
CeldaDestino(BaseDestino + ColumnasDestino) = Suma
Suma = 0
'***********************************
'suma vertical de la ultima columna
For X = 2 To FilasDestino - 1
BaseDestino = (X - 1) * ColumnasDestino
Suma = Suma + CeldaDestino(BaseDestino + ColumnasDestino)
Next X
BaseDestino = 0 'primera fila
CeldaDestino(BaseDestino + ColumnasDestino) = Suma
Suma = 0
'***********************************
'obtiene la suma de la ultima fila para despues sumarlo
'a las columnas y obtener el resultado de las sumas de la primera fila
For X = 1 To ColumnasDestino
BaseDestino = (FilasDestino - 1) * ColumnasDestino
Suma = Suma + CeldaDestino(BaseDestino + X)
Next X
SumaUltimaFila = Suma
Suma = 0
Debug.Print "LEEME *****:"
Debug.Print "BaseDestino="; BaseDestino
Debug.Print "columnas="; Columnas
Debug.Print "SumaUltimaFila="; SumaUltimaFila
'*************************************
'suma de la primera fila
For X = 1 To ColumnasDestino - 1
For Y = 2 To FilasDestino - 1
BaseDestino = (Y - 1) * ColumnasDestino
Suma = Suma + CeldaDestino(BaseDestino + X)
Next Y
Suma = Suma + SumaUltimaFila
BaseDestino = 0 '1ra fila
CeldaDestino(BaseDestino + X) = Suma
Suma = 0
Next X
'**********************************************
'imprime las celdas destino
cadena = ""
Debug.Print "*************************************" & vbCrLf
'For X = 1 To ColumnasDestino
'BaseDestino = (X - 1) * ColumnasDestino
'For Y = BaseDestino + 1 To BaseDestino + ColumnasDestino
'cadena = cadena & CeldaDestino(Y) & " "
'Next Y
'cadena = cadena & vbCrLf
'Next X
For X = 1 To FilasDestino
For Y = 1 To ColumnasDestino
BaseDestino = (X - 1) * ColumnasDestino
cadena = cadena & CeldaDestino(BaseDestino + Y) & " "
Next Y
cadena = cadena & vbCrLf
Next X
Debug.Print cadena
End Function
Código:
Option Explicit
'Form1
Private Sub Form_Load()
Krabby_ZigZag 64
End Sub
use las etiquetas de codigo simple para que se pueda hacer copy/paste al codigo por si kieren probarlo.
nota: no funka con el numero cero "0" , por que mi array empieza desde "1", black en el 1er post dijiste q no importaba si el array comienza de "0" o "1".
-Veo que has cambiado las reglas, ahora es "bidimensional", es obligatorio? o lo dejo asi?
edito:
PD: me adelante a las 3 horas q te dije xp xp
