Arrays (Matriz) multidimensional

No conozco una funcion que te devuelva la cantidad de dimensiones, pero una
solucion podria ser pasar un parametro mas a tu funcion indicando la
cantidad de dimensiones, o atrapar el error al hacer UBound(mimatriz,5), por
ejemplo:

On error Resume Next
For x=1 to 10
y=UBound(mimatriz,x)
if Err.Number<>0 then
Exit For
endif
Next x
On Error Goto 0
Dimensiones=x-1

Un saludo, Víctor Koch.


"LEspinosa" escribió en el mensaje
news:OIm$

Hola a todos:

En una función , uno de los parámetros que le paso, es una matriz dinámica
multidimensional; el problema surge cuando intento recorrer esa matriz,

pues

aunque puedo hallar dentro del procedimiento cuantas dimensiones tiene
usando UBound y control de errores, no se me ocurre como puedo recorrer
dicha matriz y extraer sus datos, pues como he dicho anteriormente
desconozco de antemano (en tiempo de compilación) el número de dimensiones
de dicha matriz.
Ese parámetro que paso, la matriz, lo impone la interfaz, por lo que no
puedo modificarlo por una colección de clases, por ejemplo.


¿Alguna idea o sugerencia?


Gracias a todos de antemano.
Leonardo Espinosa

Hola Leonardo:

Me gustó tu desafío.

Te hice un programita de ejemplo.
Mira, no sé si habrá alguna forma más sencilla de hacerlo, aunque no creo
que se pueda acceder a una matriz sin poner todos los índices necesarios
(estampados en el código) según las dimensiones que tenga, así que mi
ejemplo no anda para cualquier número de dimensiones, sino que uno por
programa le establede el límite de dimensiones con las que va a ponder
funcionar. En este caso le puse que funcione hasta 10 dimensiones como
máximo.

El ejemplo simplemente te devuelve un texto con todo el contenido de la
matriz, sin importar cuantas dimensiones tenga.

El proyecto está adjunto y también lo pego aquí.

Abrir un proyecto nuevo, y agregar un módulo de clase.
Agregar tres botones de comando al formulario y pegar este código:
*********************FORM*******************************
Option Explicit

Private Sub Command1_Click()
Dim iVar()
Dim iClase As New Class1

ReDim iVar(2)

iVar(0) = 1
iVar(1) = 2
iVar(2) = 3

MsgBox iClase.Listar(iVar)
End Sub

Private Sub Command2_Click()
Dim iVar()
Dim iClase As New Class1

ReDim iVar(2, 2)

iVar(0, 0) = 1
iVar(0, 1) = 2
iVar(0, 2) = 3
iVar(1, 0) = 4
iVar(1, 1) = 5
iVar(1, 2) = 6
iVar(2, 0) = 7
iVar(2, 1) = 8
iVar(2, 2) = 9

MsgBox iClase.Listar(iVar)
End Sub

Private Sub Command3_Click()
Dim iVar()
Dim iClase As New Class1

ReDim iVar(1 To 2, 2, 2)

iVar(0, 0, 0) = 1
iVar(0, 0, 1) = 2
iVar(0, 0, 2) = 3
iVar(0, 1, 0) = 4
iVar(0, 1, 1) = 5
iVar(0, 1, 2) = 6
iVar(0, 2, 0) = 7
iVar(0, 2, 1) = 8
iVar(0, 2, 2) = 9

iVar(1, 0, 0) = 10
iVar(1, 0, 1) = 11
iVar(1, 0, 2) = 12
iVar(1, 1, 0) = 13
iVar(1, 1, 1) = 14
iVar(1, 1, 2) = 15
iVar(1, 2, 0) = 16
iVar(1, 2, 1) = 17
iVar(1, 2, 2) = 18

iVar(2, 0, 0) = 19
iVar(2, 0, 1) = 20
iVar(2, 0, 2) = 21
iVar(2, 1, 0) = 22
iVar(2, 1, 1) = 23
iVar(2, 1, 2) = 24
iVar(2, 2, 0) = 25
iVar(2, 2, 1) = 26
iVar(2, 2, 2) = 27

MsgBox iClase.Listar(iVar)
End Sub

*****************************************************
En el módulo de clase pegar el sig. código:

************************CLASE***********************
Option Explicit

Private mMatriz()
Private mDimensiones As Long
Private mPrimerElemento() As Long
Private mUltimoElemento() As Long
Private mIndicesMatriz() As Long

Private mTextoSalida As String


Public Property Get Matriz1(nArgs As Variant) As Variant
Matriz1 = mMatriz(nArgs(0))
End Property

Public Property Get Matriz2(nArgs As Variant) As Variant
Matriz2 = mMatriz(nArgs(0), nArgs(1))
End Property

Public Property Get Matriz3(nArgs As Variant) As Variant
Matriz3 = mMatriz(nArgs(0), nArgs(1), nArgs(2))
End Property

Public Property Get Matriz4(nArgs As Variant) As Variant
Matriz4 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3))
End Property

Public Property Get Matriz5(nArgs As Variant) As Variant
Matriz5 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3), nArgs(4))
End Property

Public Property Get Matriz6(nArgs As Variant) As Variant
Matriz6 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3), nArgs(4),
nArgs(5))
End Property

Public Property Get Matriz7(nArgs As Variant) As Variant
Matriz7 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3), nArgs(4),
nArgs(5), nArgs(6))
End Property

Public Property Get Matriz8(nArgs As Variant) As Variant
Matriz8 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3), nArgs(4),
nArgs(5), nArgs(6), nArgs(7))
End Property

Public Property Get Matriz9(nArgs As Variant) As Variant
Matriz9 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3), nArgs(4),
nArgs(5), nArgs(6), nArgs(7), nArgs(8))
End Property

Public Property Get Matriz10(nArgs As Variant) As Variant
Matriz10 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3), nArgs(4),
nArgs(5), nArgs(6), nArgs(7), nArgs(8), nArgs(9))
End Property

Public Function Listar(nMatriz As Variant) As String
Dim iCont As Long

mMatriz = nMatriz

iCont = 1
ReDim mUltimoElemento(1)
ReDim mPrimerElemento(1)
On Error Resume Next
Do
mUltimoElemento(iCont) = UBound(mMatriz, iCont)
If Err.Number = 0 Then
mPrimerElemento(iCont) = LBound(mMatriz, iCont)
iCont = iCont + 1
ReDim Preserve mUltimoElemento(iCont)
ReDim Preserve mPrimerElemento(iCont)
End If
Loop Until Err.Number <> 0
Err.Clear
On Error GoTo 0

mDimensiones = UBound(mUltimoElemento) - 1

ReDim mIndicesMatriz(mDimensiones)
mTextoSalida = ""

Recorrer 1

Listar = mTextoSalida
End Function

Private Sub Recorrer(nDimension As Long)
Dim iCont As Long

For iCont = mPrimerElemento(nDimension) To mUltimoElemento(nDimension)
mIndicesMatriz(nDimension - 1) = iCont
If nDimension < mDimensiones Then
Recorrer nDimension + 1
Else
Select Case mDimensiones
Case 1
mTextoSalida = mTextoSalida & CallByName(Me, "Matriz1",
VbGet, mIndicesMatriz) & vbCrLf
Case 2
mTextoSalida = mTextoSalida & CallByName(Me, "Matriz2",
VbGet, mIndicesMatriz) & vbCrLf
Case 3
mTextoSalida = mTextoSalida & CallByName(Me, "Matriz3",
VbGet, mIndicesMatriz) & vbCrLf
Case 4
mTextoSalida = mTextoSalida & CallByName(Me, "Matriz4",
VbGet, mIndicesMatriz) & vbCrLf
Case 5
mTextoSalida = mTextoSalida & CallByName(Me, "Matriz5",
VbGet, mIndicesMatriz) & vbCrLf
Case 6
mTextoSalida = mTextoSalida & CallByName(Me, "Matriz6",
VbGet, mIndicesMatriz) & vbCrLf
Case 7
mTextoSalida = mTextoSalida & CallByName(Me, "Matriz7",
VbGet, mIndicesMatriz) & vbCrLf
Case 8
mTextoSalida = mTextoSalida & CallByName(Me, "Matriz8",
VbGet, mIndicesMatriz) & vbCrLf
Case 9
mTextoSalida = mTextoSalida & CallByName(Me, "Matriz9",
VbGet, mIndicesMatriz) & vbCrLf
Case 10
mTextoSalida = mTextoSalida & CallByName(Me, "Matriz10",
VbGet, mIndicesMatriz) & vbCrLf
End Select
End If
Next
End Sub
************************************************************

Saludos,
Javier


"LEspinosa" escribió en el mensaje
news:OIm$

Hola a todos:

En una función , uno de los parámetros que le paso, es una matriz dinámica
multidimensional; el problema surge cuando intento recorrer esa matriz,

pues

aunque puedo hallar dentro del procedimiento cuantas dimensiones tiene
usando UBound y control de errores, no se me ocurre como puedo recorrer
dicha matriz y extraer sus datos, pues como he dicho anteriormente
desconozco de antemano (en tiempo de compilación) el número de dimensiones
de dicha matriz.
Ese parámetro que paso, la matriz, lo impone la interfaz, por lo que no
puedo modificarlo por una colección de clases, por ejemplo.


¿Alguna idea o sugerencia?


Gracias a todos de antemano.
Leonardo Espinosa

Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.493 / Virus Database: 292 - Release Date: 25/06/2003


begin 666 ListarMatriz.zip
M4$L#!!0````(`%A3YRZ':A9+BP,``/@1```*````0VQA<W,Q+F-L<[V66V_:
M,!2 WY'X#Q8/&]%H1;@CM9. 4H3$30WT=7+ ;3,%&SD):O?K=QQC< )E298M
M#\3QN7WGV-CG>?ADC><S9-Y6T6#2LZQBH3\<C6?%`D+3P/6Î0/;HQ$?JZ
MY $1\PO"/<?SL>T*414D,^9KDT+G`?NX[]"-0U_[Y WO'<8/NGM[QNA1QV(!
M7Y.CRIG.=&DM.:8>7OL.HU.V(>@4LT=!/+=_DK5?+ QG#\5"S_>Y8P<^0<_]
M'S.\%8"]SRS%I".7V=@5.M8.KX7B(W8]$M,:<()5IC+_B'C!R8:L70RO
M\>83%\/W'?.()IWO1"X(YEUG[0!ZL;#@SAZ#^G:*P?)7V="F'IPMH1Y8$ _U
M/#1A]%63PF!+^- EH.2SLG%!907+N&575<:P4FOBJ>@G#4UG2=Y]9F'7V6 A
MMT!5:H!.8$,J:,'9CG#_`XV(CZ0OLTQ[_#4$?\;<P=0WM+%88:0TH4 J_="F
M7#6@#$.Z.?J]'JJ6.%3M0J@*DB,S7=!ZXJ#UJT'5J)8N?"-Q^$;"\&I43P?2
M3 S23 VB1HUT2*W$2*V_0%*C9CJX=F*X=BYP:M1*A]E)C-G)&5.-VNF NXF!
MN_\,6(TZZ=#-:O*SLOH?X-6H>R6-QX"&%S.:B+N?EZEDBJ>@[@J1`5QGR!DP
MZI\N&3$M?P\Y078'3[I06MTC4WX^$>$J?KN91D0:NQZ5= [7+^?0<#P1+X N
M809WVP&/R7=($_,=`AA L.JS@&[*!]J*)#-.AN,7X?YV%FQM(ON>Y1NA)WGH
M/(9V=#[/QJ%+(]S=5$O7(Y*$Y\0C?GW<`ESS&32[2G4S$?AB_R.\)8SNT
MHK[CZEG??4=5*1>3`Y=@'JO]B"V9TCDLO][KG,H<Q3?0C<HWLM31'D9W=>".
M=##0%Y:B3M:,<^ VQ?8.TPJWM/BC:7;RGZ"VO=X?68%]=%*FQ^AJEQL)=O\C
M%$6M;'P!3AX-!&6++ZDFUO9OM"0:%%304-LGLFTUG;OH<ISOX&/)-*/(5AR&
M[:YN8A$7FG4TP%ZTL8UJB2=4,<_GQ1-;R,CG%[!TW?Z':.S+4U)!I<.16:J@
M9QM.VTJL+ :8[.T!G[Q\`E'+#Z*6&:*>'T0],T0C/XA&9HAF?A#-S!"M_"!:
MF2':^4&T,T-T\H/H9(;HY@?1S0QA5G,\K:II,<2U)$]7[?S5+FG9X81:@5TL
M_ 902P,$% ````@`,U/G+N$;O39/`@``Y0D```D```!&;W)M,2YF<FVU5$MO
MXC 8O"/Q'RQ.1:J0[20\#GLHE.XBL;0JB#U6)O%\]>//&Q,4%>B
M2 1EYINQ9YRPG;^N%\\K$ P@[':F=,]2L)T.GK(\`?*"0+<#`)B1`V=9"JK/
M-_'M*;ZG^9C1E/^@;/_.*]Y'06"02_J;-V*,)M @-]G!<$8C2_F+1?R])GUO
MHLDE2S^$CH4M>UJ')*;-ENP]*;(QMIWK&F99DI TFAXY%^'+.T]7`EI:\< C
M2WK5B+%^LTZYC/@TI30T\GU8\1NR6Z01/9D\KLFZ-(.$C=B(5_,(([WX/(T^
MD15?SXJ_.BNZEM44WR KNIX5?756>"WK^'^BJLL#YSG;'3D5@=]6)*%BL'X]
M+/)[G.U(+$?6!Q+*N2<2%_1L:I93PLDN;N-?<AK1,";B9Q&)F4U^/!^9GPY9
M0:/&X%GW+/"8A8QW.]W.2\[^$#&^/N[/AQUU?-R".`; MR:W[64P*
M"AX*L*)_@;PIRD='7U]IK<)]DU 0[(LM(0- $L &@"<*?Q7Z:G<J%!TM6
M<#$F9_NJ?[G_ECCXMG'NP:5$]\ ))3 G%Y3J)IH.7VI]&U/:P,:4üV5&I'
M-J:T8QM3VLEM*O5N6BD2;R"0.VRM]G*[+05?ZEB.7JA9PT[3&G;*AFJ+3M\:
M=BJ'9:#SUNLSKT)!!U=>"#FX,D/8QJM<R'-P[7/^7%4^Y\]6Y3-T<.TS<G#M
M,W;282/=Q,'UF4$'5VX8V7B5#F,'USZ>@VL?W\:K=#AP<.TS='#M,S+3??*-
M^0P,$% ````@`6%/G+F340#VF`0``J0(```P```!0<F]J96-T,2YV8G!5
M4DUOFT 0O2/Q'RQ\:2,5K7&42\0AP:9%JFT47.=0Y[# $&^Z'VAW<>Q6_>_M8=VD16B8>8]AWCQV>^XA79X@#'*E18IA%G=:A,$#=*!!-I!>[3__(H0DY'I.
M/KGD$K*_F;^N;WY/DYA,R32.]__>C\5ZL7FL]M796!#S9&]7U=/-U
M.;D;K!+4,B7#(./4F'2,L]N)?\8--V%0-$J.&J-19!0&E:7:#OT[D"DAJ&SG
M21JY:DT%I%&IU0LT%NDOP/M,20LG6RS2B/B.WDVN.:Q4"QY;T1>E=Z#3F<N9
M]#E!0X[,.)&7$E47LM$@0-H+5H$^@JZ&OE?:YHR#0!V#?.DF<O:REZ#89>
M)# ^KK_%G^$:\#\OI4>G2C6*#<#M]L.(CPIF3O6/PNH!Z>"YDIQ!<
MJSO.J&'R&:M[-<C69 =H?HP?=PH[KE[?@)R7BDG[7B^*W5OQ36ILAS8OQP71
M\M&JD:/6`I+>'DN9]/GVH(&V)>A-C>8CM**G]2!J!W6>->AO&'Q?59.MIM+0
M!M>=> N?O+_N##J7#OCF'U!+`0(4`!0````(`%A3YRZ':A9+BP,``/@1```*
M``````````$`( "````!#;&%S<S$N8VQS4$L!`A0`% ````@`,U/G+N$;
MO39/`@``Y0D```D``````````0`@`+:!LP,``$9O<FTQ+F9R;5!+`0(4`!0`
M```(`%A3YRYDU$ ]I@$``*D"```,``````````$`( "&``!0<F]J96-T
;,2YV8G!02P4&``````,``P"I````^0<`````
`
end

En el código del form cambiar la línea en el evento del Command3 a:
ReDim iVar(2, 2, 2)
o sino eliminar las primeras asignaciones que son con índice 0, x, x

Resulta que me di cuenta que me había complicado innecesariamente con el
CallByName, así que acá va de nuevo el módulo de clase modificado:

**************************CLASE******************************
Option Explicit

Private mMatriz()
Private mDimensiones As Long
Private mPrimerElemento() As Long
Private mUltimoElemento() As Long
Private mIndicesMatriz() As Long

Private mTextoSalida As String

Public Function Listar(nMatriz As Variant) As String
Dim iCont As Long

mMatriz = nMatriz

iCont = 1
ReDim mUltimoElemento(1)
ReDim mPrimerElemento(1)
On Error Resume Next
Do
mUltimoElemento(iCont) = UBound(mMatriz, iCont)
If Err.Number = 0 Then
mPrimerElemento(iCont) = LBound(mMatriz, iCont)
iCont = iCont + 1
ReDim Preserve mUltimoElemento(iCont)
ReDim Preserve mPrimerElemento(iCont)
End If
Loop Until Err.Number <> 0
Err.Clear
On Error GoTo 0

mDimensiones = UBound(mUltimoElemento) - 1

ReDim mIndicesMatriz(mDimensiones)
mTextoSalida = ""

Recorrer 1

Listar = mTextoSalida
End Function

Private Sub Recorrer(nDimension As Long)
Dim iCont As Long

For iCont = mPrimerElemento(nDimension) To mUltimoElemento(nDimension)
mIndicesMatriz(nDimension - 1) = iCont
If nDimension < mDimensiones Then
Recorrer nDimension + 1
Else
Select Case mDimensiones
Case 1
mTextoSalida = mTextoSalida & mMatriz(mIndicesMatriz(0))
& vbCrLf
Case 2
mTextoSalida = mTextoSalida & mMatriz(mIndicesMatriz(0),
mIndicesMatriz(1)) & vbCrLf
Case 3
mTextoSalida = mTextoSalida & mMatriz(mIndicesMatriz(0),
mIndicesMatriz(1), mIndicesMatriz(2)) & vbCrLf
Case 4
mTextoSalida = mTextoSalida & mMatriz(mIndicesMatriz(0),
mIndicesMatriz(1), mIndicesMatriz(2), mIndicesMatriz(3)) & vbCrLf
Case 5
mTextoSalida = mTextoSalida & mMatriz(mIndicesMatriz(0),
mIndicesMatriz(1), mIndicesMatriz(2), mIndicesMatriz(3), mIndicesMatriz(4))
& vbCrLf
Case 6
mTextoSalida = mTextoSalida & mMatriz(mIndicesMatriz(0),
mIndicesMatriz(1), mIndicesMatriz(2), mIndicesMatriz(3), mIndicesMatriz(4),
mIndicesMatriz(5)) & vbCrLf
Case 7
mTextoSalida = mTextoSalida & mMatriz(mIndicesMatriz(0),
mIndicesMatriz(1), mIndicesMatriz(2), mIndicesMatriz(3), mIndicesMatriz(4),
mIndicesMatriz(5), mIndicesMatriz(6)) & vbCrLf
Case 8
mTextoSalida = mTextoSalida & mMatriz(mIndicesMatriz(0),
mIndicesMatriz(1), mIndicesMatriz(2), mIndicesMatriz(3), mIndicesMatriz(4),
mIndicesMatriz(5), mIndicesMatriz(6), mIndicesMatriz(7)) & vbCrLf
Case 9
mTextoSalida = mTextoSalida & mMatriz(mIndicesMatriz(0),
mIndicesMatriz(1), mIndicesMatriz(2), mIndicesMatriz(3), mIndicesMatriz(4),
mIndicesMatriz(5), mIndicesMatriz(6), mIndicesMatriz(7), mIndicesMatriz(8))
& vbCrLf
Case 10
mTextoSalida = mTextoSalida & mMatriz(mIndicesMatriz(0),
mIndicesMatriz(1), mIndicesMatriz(2), mIndicesMatriz(3), mIndicesMatriz(4),
mIndicesMatriz(5), mIndicesMatriz(6), mIndicesMatriz(7), mIndicesMatriz(8),
mIndicesMatriz(9)) & vbCrLf
End Select
End If
Next
End Sub
*************************************************************

"Javier Balkenende" escribió en el mensaje
news:%

Hola Leonardo:

Me gustó tu desafío.

Te hice un programita de ejemplo.
Mira, no sé si habrá alguna forma más sencilla de hacerlo, aunque no creo
que se pueda acceder a una matriz sin poner todos los índices necesarios
(estampados en el código) según las dimensiones que tenga, así que mi
ejemplo no anda para cualquier número de dimensiones, sino que uno por
programa le establede el límite de dimensiones con las que va a ponder
funcionar. En este caso le puse que funcione hasta 10 dimensiones como
máximo.

El ejemplo simplemente te devuelve un texto con todo el contenido de la
matriz, sin importar cuantas dimensiones tenga.

El proyecto está adjunto y también lo pego aquí.

Abrir un proyecto nuevo, y agregar un módulo de clase.
Agregar tres botones de comando al formulario y pegar este código:
*********************FORM*******************************
Option Explicit

Private Sub Command1_Click()
Dim iVar()
Dim iClase As New Class1

ReDim iVar(2)

iVar(0) = 1
iVar(1) = 2
iVar(2) = 3

MsgBox iClase.Listar(iVar)
End Sub

Private Sub Command2_Click()
Dim iVar()
Dim iClase As New Class1

ReDim iVar(2, 2)

iVar(0, 0) = 1
iVar(0, 1) = 2
iVar(0, 2) = 3
iVar(1, 0) = 4
iVar(1, 1) = 5
iVar(1, 2) = 6
iVar(2, 0) = 7
iVar(2, 1) = 8
iVar(2, 2) = 9

MsgBox iClase.Listar(iVar)
End Sub

Private Sub Command3_Click()
Dim iVar()
Dim iClase As New Class1

ReDim iVar(1 To 2, 2, 2)

iVar(0, 0, 0) = 1
iVar(0, 0, 1) = 2
iVar(0, 0, 2) = 3
iVar(0, 1, 0) = 4
iVar(0, 1, 1) = 5
iVar(0, 1, 2) = 6
iVar(0, 2, 0) = 7
iVar(0, 2, 1) = 8
iVar(0, 2, 2) = 9

iVar(1, 0, 0) = 10
iVar(1, 0, 1) = 11
iVar(1, 0, 2) = 12
iVar(1, 1, 0) = 13
iVar(1, 1, 1) = 14
iVar(1, 1, 2) = 15
iVar(1, 2, 0) = 16
iVar(1, 2, 1) = 17
iVar(1, 2, 2) = 18

iVar(2, 0, 0) = 19
iVar(2, 0, 1) = 20
iVar(2, 0, 2) = 21
iVar(2, 1, 0) = 22
iVar(2, 1, 1) = 23
iVar(2, 1, 2) = 24
iVar(2, 2, 0) = 25
iVar(2, 2, 1) = 26
iVar(2, 2, 2) = 27

MsgBox iClase.Listar(iVar)
End Sub

*****************************************************
En el módulo de clase pegar el sig. código:

************************CLASE***********************
Option Explicit

Private mMatriz()
Private mDimensiones As Long
Private mPrimerElemento() As Long
Private mUltimoElemento() As Long
Private mIndicesMatriz() As Long

Private mTextoSalida As String


Public Property Get Matriz1(nArgs As Variant) As Variant
Matriz1 = mMatriz(nArgs(0))
End Property

Public Property Get Matriz2(nArgs As Variant) As Variant
Matriz2 = mMatriz(nArgs(0), nArgs(1))
End Property

Public Property Get Matriz3(nArgs As Variant) As Variant
Matriz3 = mMatriz(nArgs(0), nArgs(1), nArgs(2))
End Property

Public Property Get Matriz4(nArgs As Variant) As Variant
Matriz4 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3))
End Property

Public Property Get Matriz5(nArgs As Variant) As Variant
Matriz5 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3), nArgs(4))
End Property

Public Property Get Matriz6(nArgs As Variant) As Variant
Matriz6 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3), nArgs(4),
nArgs(5))
End Property

Public Property Get Matriz7(nArgs As Variant) As Variant
Matriz7 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3), nArgs(4),
nArgs(5), nArgs(6))
End Property

Public Property Get Matriz8(nArgs As Variant) As Variant
Matriz8 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3), nArgs(4),
nArgs(5), nArgs(6), nArgs(7))
End Property

Public Property Get Matriz9(nArgs As Variant) As Variant
Matriz9 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3), nArgs(4),
nArgs(5), nArgs(6), nArgs(7), nArgs(8))
End Property

Public Property Get Matriz10(nArgs As Variant) As Variant
Matriz10 = mMatriz(nArgs(0), nArgs(1), nArgs(2), nArgs(3), nArgs(4),
nArgs(5), nArgs(6), nArgs(7), nArgs(8), nArgs(9))
End Property

Public Function Listar(nMatriz As Variant) As String
Dim iCont As Long

mMatriz = nMatriz

iCont = 1
ReDim mUltimoElemento(1)
ReDim mPrimerElemento(1)
On Error Resume Next
Do
mUltimoElemento(iCont) = UBound(mMatriz, iCont)
If Err.Number = 0 Then
mPrimerElemento(iCont) = LBound(mMatriz, iCont)
iCont = iCont + 1
ReDim Preserve mUltimoElemento(iCont)
ReDim Preserve mPrimerElemento(iCont)
End If
Loop Until Err.Number <> 0
Err.Clear
On Error GoTo 0

mDimensiones = UBound(mUltimoElemento) - 1

ReDim mIndicesMatriz(mDimensiones)
mTextoSalida = ""

Recorrer 1

Listar = mTextoSalida
End Function

Private Sub Recorrer(nDimension As Long)
Dim iCont As Long

For iCont = mPrimerElemento(nDimension) To mUltimoElemento(nDimension)
mIndicesMatriz(nDimension - 1) = iCont
If nDimension < mDimensiones Then
Recorrer nDimension + 1
Else
Select Case mDimensiones
Case 1
mTextoSalida = mTextoSalida & CallByName(Me,

"Matriz1",

VbGet, mIndicesMatriz) & vbCrLf
Case 2
mTextoSalida = mTextoSalida & CallByName(Me,

"Matriz2",

VbGet, mIndicesMatriz) & vbCrLf
Case 3
mTextoSalida = mTextoSalida & CallByName(Me,

"Matriz3",

VbGet, mIndicesMatriz) & vbCrLf
Case 4
mTextoSalida = mTextoSalida & CallByName(Me,

"Matriz4",

VbGet, mIndicesMatriz) & vbCrLf
Case 5
mTextoSalida = mTextoSalida & CallByName(Me,

"Matriz5",

VbGet, mIndicesMatriz) & vbCrLf
Case 6
mTextoSalida = mTextoSalida & CallByName(Me,

"Matriz6",

VbGet, mIndicesMatriz) & vbCrLf
Case 7
mTextoSalida = mTextoSalida & CallByName(Me,

"Matriz7",

VbGet, mIndicesMatriz) & vbCrLf
Case 8
mTextoSalida = mTextoSalida & CallByName(Me,

"Matriz8",

VbGet, mIndicesMatriz) & vbCrLf
Case 9
mTextoSalida = mTextoSalida & CallByName(Me,

"Matriz9",

VbGet, mIndicesMatriz) & vbCrLf
Case 10
mTextoSalida = mTextoSalida & CallByName(Me,

"Matriz10",

VbGet, mIndicesMatriz) & vbCrLf
End Select
End If
Next
End Sub
************************************************************

Saludos,
Javier


"LEspinosa" escribió en el mensaje
news:OIm$
> Hola a todos:
>
> En una función , uno de los parámetros que le paso, es una matriz

dinámica

> multidimensional; el problema surge cuando intento recorrer esa matriz,
pues
> aunque puedo hallar dentro del procedimiento cuantas dimensiones tiene
> usando UBound y control de errores, no se me ocurre como puedo recorrer
> dicha matriz y extraer sus datos, pues como he dicho anteriormente
> desconozco de antemano (en tiempo de compilación) el número de

dimensiones

> de dicha matriz.
> Ese parámetro que paso, la matriz, lo impone la interfaz, por lo que no
> puedo modificarlo por una colección de clases, por ejemplo.
>
>
> ¿Alguna idea o sugerencia?
>
>
> Gracias a todos de antemano.
> Leonardo Espinosa
>
>
>



Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.493 / Virus Database: 292 - Release Date: 25/06/2003

Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.493 / Virus Database: 292 - Release Date: 25/06/2003


begin 666 ListarMatriz.zip
M4$L#!!0````(`$A6YR[#Q *?] (``'X.```*````0VQA<W,Q+F-L<^56WT_;
M,!!^K]3_P>)A:S1 #;^18%(;"JK4IHBTO$Y.8L!3:E=V4B'^^IWC_+ 36/:P
M:;#YH6GNOCM_W]W%R?WD+?.3N#Y$W&P5!OS>>W$S]?@^A>9:D="4)ND1[
M+D*?ER(CRGY+A*0RQ6&B7$/P^#PUC ISA5,\IBRF['%,GO"6<E%@MZ'/684)
M>"8B4D%:F/DR6 K,)(Y2RMF<QP35>XX8N!?A=Q*E_=[$O^KW1FDJ:)BE!-V/
MO_EXK0CN> F6TMUI>&\2'N)$88(-CA3P&B>2-%">(+A4JO5;[EM!8A(E&"[3
M^(T4D^<-E\3P+C9*"P)[0B,*U/N]6T&W&.#K.8;(EX%CF*[HFC )$42BD40S
MSAX-+_Q9$S%)"(!2/G!>@:^4\@4.A416>Y>(PS,DCRG/, )C;'R!P`M
M$%D(0M!UQO(FH9F:`S%@.IO"WF-!,4L=,P[!`FF(>IRE]8;*K'^+6D#½RF
M4T==(E??WA&5JJG4=2QOHU2E=P&M$ *&[X[(#";&!YT%/:ZO.9M&[IR `PQ6
M8YZQ>%"PW=7,G#IP^J#2[_O9.B3Z&5@^$5;[\^0-:E7R64=RM<I2Z.N7LB3E
MTN)A4"41V_8TO):Q&?(JNSIDPF)0J>]GG&_0BJ4T,55??$5#[5=&+R%8-&I_
MPY>\Q!3M-^>^+K--WT%[I5ZKU?8\FZD*WM8TPQFQ8R>)N!# VU7CG<O*1QJ
M9AR<.:"\''OS60FRL$HR8-7NY90[OS#]UU"4LK/-!M09'01E:[;4<!OS:Y?$
M( 45=,KQL<;6P%S8[6A/<%4R(\@:Q4E^])DA`$8>EO8A9Z/4RB%NVZY6
MHY'6[:?J/&VH'SH..+>A)V8/;VQW\%NWVVW6W^UF</BG&;1,!]VDCOX"J9;I
ML)OG\?(==5,_>;?46Z;C;C6G'TE-RW32+?#[-9__>YI;IK/N
M,KC#_Z(.+=/YFZ51'T3ZO6Z\^8W/0_UMG:.RL-_[`5!+`P04````" !45N<N
ME.$:*4H"``#@"0``"0```$9O<FTQ+F9R;;542V_B,!B\(_$?+$Y%JI#M)#P.
M>RB4[B*QM"J(/59.XJ56\T")V>7GKV/G8<<$&*1%!FOAE[[Y>MV];P!
"?F].#RP!^_GH*<UB4%P0Z/<```MRY"Q-0/7Y)KX#R0\4'S&:\!^4'=YY
MQ;O(\S1R37_S1HS1#&KD+CUJSFAB*'^QD+_7I.O,%+EFR8?0L:!C3]N 1+39
MDKDG23;&IG-=PR*-8Y*$\Q/G(GQYYZA*0$<K#GAD\: :T=9OUBF7$9^FE(9&
?D?\51+2L\[CFJQ+TTC8B+5X-8\P4HLOD_ 36?'UK/BKLZ)K677Q#;*B
MZUG15V>%U[)._R>JO#QPGC'_Q*D(_+8A,16#]>MAD-^CU"=1,;(]DJ"8>R)1
M3EM3BXP23ORHBW_):$B#B(B?52AF=MFI/;(\'].<AHW!L^I9X!$+&._W^KV7
MC/TA8GQ[\NN#>1/_`\''W5 U((X!L#W)C/M%1'(*'G*PH7]!<9.7CXZZOM):
MA8<Z(2$X%%M"&H *`&L`+@!'%_[,#_/T7"X\6K.<B[%B¼[+_;?$0??-LX]
MN)3H'EBA!&;:;"EUK7Q*36,S&I'>L]E=J)B4GMU,2D=G:;2IV;5]K9
MZN5B.[J]5&\Q>J%A!5LE*]CJ&<HM6E4KV&H;EH':A=?'786"%BZ]$+)P:8:P
MB5>YD&/ARJ?]2%4^[<>J\AE;N/*96+CRF5KIL)9N9N'JS*"%2S>,3+Q*A[&%
M*Q_'PI6/:^)5.NQ9N/(96[CRF>CI/OFR_ -02P,$% ````@`HU;G+F340#VF
M`0``J0(```P```!0<F]J96-T,2YV8G!54DUOFT 0O2/Q'RQ\:2,5K7&42\0A
MP:9%JFT47.=0Y[# $&^Z'VAW<>Q6_>_=8=VD16B8>8]AWCQV>^XA79X@#'*E
M18IA%G=:A,$#=*!!-I!>[3__(H0DY'I./KGD$K*_F;^N;WY/DYA,R32.]__>
MC\5ZL7FL]M796!#S9&]7U=/-U.;D;K!+4,B7#(./4F'2,L]N)?\8-
M-V%0-$J.&J-19!0&E:7:#OT[D"DAJ&SG21JY:DT%I%&IU0LT%NDOP/M,20LG
M6RS2B/B.WDVN.:Q4"QY;T1>E=Z#3F<N9]#E!0X[,.)&7$E47LM$@0-H+5H$^
&OE?:YHR#0!V#?.DF<O:REZ#89>)# ^KK_%G^$:\#\OI4>G2
MC6*#<#M]L.(CPIF3O6/PNH!Z>"YDIQ!<JSO.J&'R&:M[-<C69 =H?HP?=PH[
MKE[?@)R7BDG[7B^*W5OQ36ILAS8OQP71\M&JD:/6`I+>'DN9]/GVH(&V)>A-
MC>8CM**G]2!J!W6>->AO&'Q?59.MIM+0!M>=> N?O+_N##J7#OCF'U!+`0(4
M`!0````(`$A6YR[#Q *?] (``'X.```*``````````$`( "````!#;&%S
M<S$N8VQS4$L!`A0`% ````@`5%;G+I3A&BE*`@``X D```D``````````0`@
M`+:!' ,``$9O<FTQ+F9R;5!+`0(4`!0````(`*-6YRYDU$ ]I@$``*D"```,
M``````````$`( "%``!0<F]J96-T,2YV8G!02P4&``````,``P"I````
&70<`````
`
end

En primer lugar gracias por vuestras respuestas, gracias Javier y Victor.
Pero vereis, el código que me pasaste Javier no me satisfacía completamente,
pues me limitaba el número de dimensiones, o mejor dicho, si quería usar más
de 50 dimensiones por ejemplo, el select case que tenía que construir era
enorme, así que seguí buscando, y recordé la función VarPtr y VarPtrArray
(HOWTO: Get the Address of Variables in Visual Basic - Knowledge Base
199824).
Utilicé la estructura SAFEARRAY y CopyMemory, para utilizar punteros y
demás.
Así que pegando piezas de aquí y de allá, un poco de sal, pimienta y
probando diversas combinaciones... obtuve el siguiente resultado que a
continuación pego por si os vale:



En las declaraciones de un modulo:

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As
Any, Source As Any, ByVal Length As Long)
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (Ptr()
As Any) As Long

Public Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type

Public Type SAFEARRAY1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 0) As SAFEARRAYBOUND
End Type

Public Type SAFEARRAY100D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
'Este dato hace que el límite de dimensiones esté ahora en 100
Bounds(0 To 99) As SAFEARRAYBOUND
End Type


En mi función de ese módulo:

Public Function MiFunciónArray(ByRef anDiasRotacion() As Long) As Double

Dim SA As SAFEARRAY100D, saTemp As SAFEARRAY1D
Dim lngSafeArray As Long
Dim cDims As Integer
Dim i As Long, numElems As Long

'recuperamos informacion de las dimensiones de la matriz y número de
elementos
CopyMemory lngSafeArray, ByVal VarPtrArray(anDiasRotacion), 4
CopyMemory cDims, ByVal lngSafeArray, Len(cDims)
CopyMemory SA, ByVal lngSafeArray, Len(SA) - 8 * (100 - cDims)

numElems = 1
For i = 0 To SA.cDims - 1
numElems = numElems * SA.Bounds(i).cElements
Next i

'Creamos una matriz temporal unidimensional y recuperamos su estructura
SAFEARRAY1D
ReDim aTemp(0) As Long
CopyMemory lngSafeArray, ByVal VarPtrArray(aTemp), 4
CopyMemory saTemp, ByVal lngSafeArray, Len(saTemp)

'Modifica el número de elementos y apunta a los datos
saTemp.pvData = SA.pvData
saTemp.Bounds(0).cElements = numElems
CopyMemory ByVal VarPtrArray(aTemp), VarPtr(saTemp), 4

'Y de esta forma ya tengo todos los datos en una matriz unidimensional
For i = 0 To UBound(aTemp)
Debug.Print aTemp(i)
Next i

Me parece que con una pequeña modificación de este algoritmo se podrían
manejar bitmaps con mucha mayor rapidez y rendimiento que usando los for
next.

Saludos
Leonardo Espinosa


"LEspinosa" escribió en el mensaje
news:OIm$

Hola a todos:

En una función , uno de los parámetros que le paso, es una matriz dinámica
multidimensional; el problema surge cuando intento recorrer esa matriz,

pues

aunque puedo hallar dentro del procedimiento cuantas dimensiones tiene
usando UBound y control de errores, no se me ocurre como puedo recorrer
dicha matriz y extraer sus datos, pues como he dicho anteriormente
desconozco de antemano (en tiempo de compilación) el número de dimensiones
de dicha matriz.
Ese parámetro que paso, la matriz, lo impone la interfaz, por lo que no
puedo modificarlo por una colección de clases, por ejemplo.


¿Alguna idea o sugerencia?


Gracias a todos de antemano.
Leonardo Espinosa

Hola Leonardo:

Muy bueno.
Hice unas pruebas y varias veces me funcionó bien, pero sin haber modificado
nada luego lo probé de nuevo y me cerró el IDE. El error me dio luego de
ejecutar varias veces la rutina (tal vez hice algo mal, aunque no creo).

También tengo una curiosidad ¿En qué tipo de proyecto se puede usar una
matriz de 50 dimensiones, qué podría necesitar eso?

Saludos,
Javier



"LEspinosa" escribió en el mensaje
news:%23c$

En primer lugar gracias por vuestras respuestas, gracias Javier y Victor.
Pero vereis, el código que me pasaste Javier no me satisfacía

completamente,

pues me limitaba el número de dimensiones, o mejor dicho, si quería usar

más

de 50 dimensiones por ejemplo, el select case que tenía que construir era
enorme, así que seguí buscando, y recordé la función VarPtr y VarPtrArray
(HOWTO: Get the Address of Variables in Visual Basic - Knowledge Base
199824).
Utilicé la estructura SAFEARRAY y CopyMemory, para utilizar punteros y
demás.
Así que pegando piezas de aquí y de allá, un poco de sal, pimienta y
probando diversas combinaciones... obtuve el siguiente resultado que a
continuación pego por si os vale:



En las declaraciones de un modulo:

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest

As

Any, Source As Any, ByVal Length As Long)
Public Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr"

(Ptr()

As Any) As Long

Public Type SAFEARRAYBOUND
cElements As Long
lLbound As Long
End Type

Public Type SAFEARRAY1D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
Bounds(0 To 0) As SAFEARRAYBOUND
End Type

Public Type SAFEARRAY100D
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
'Este dato hace que el límite de dimensiones esté ahora en 100
Bounds(0 To 99) As SAFEARRAYBOUND
End Type


En mi función de ese módulo:

Public Function MiFunciónArray(ByRef anDiasRotacion() As Long) As Double

Dim SA As SAFEARRAY100D, saTemp As SAFEARRAY1D
Dim lngSafeArray As Long
Dim cDims As Integer
Dim i As Long, numElems As Long

'recuperamos informacion de las dimensiones de la matriz y número de
elementos
CopyMemory lngSafeArray, ByVal VarPtrArray(anDiasRotacion), 4
CopyMemory cDims, ByVal lngSafeArray, Len(cDims)
CopyMemory SA, ByVal lngSafeArray, Len(SA) - 8 * (100 - cDims)

numElems = 1
For i = 0 To SA.cDims - 1
numElems = numElems * SA.Bounds(i).cElements
Next i

'Creamos una matriz temporal unidimensional y recuperamos su

estructura

SAFEARRAY1D
ReDim aTemp(0) As Long
CopyMemory lngSafeArray, ByVal VarPtrArray(aTemp), 4
CopyMemory saTemp, ByVal lngSafeArray, Len(saTemp)

'Modifica el número de elementos y apunta a los datos
saTemp.pvData = SA.pvData
saTemp.Bounds(0).cElements = numElems
CopyMemory ByVal VarPtrArray(aTemp), VarPtr(saTemp), 4

'Y de esta forma ya tengo todos los datos en una matriz unidimensional
For i = 0 To UBound(aTemp)
Debug.Print aTemp(i)
Next i

Me parece que con una pequeña modificación de este algoritmo se podrían
manejar bitmaps con mucha mayor rapidez y rendimiento que usando los for
next.

Saludos
Leonardo Espinosa


"LEspinosa" escribió en el mensaje
news:OIm$
> Hola a todos:
>
> En una función , uno de los parámetros que le paso, es una matriz

dinámica

> multidimensional; el problema surge cuando intento recorrer esa matriz,
pues
> aunque puedo hallar dentro del procedimiento cuantas dimensiones tiene
> usando UBound y control de errores, no se me ocurre como puedo recorrer
> dicha matriz y extraer sus datos, pues como he dicho anteriormente
> desconozco de antemano (en tiempo de compilación) el número de

dimensiones

> de dicha matriz.
> Ese parámetro que paso, la matriz, lo impone la interfaz, por lo que no
> puedo modificarlo por una colección de clases, por ejemplo.
>
>
> ¿Alguna idea o sugerencia?
>
>
> Gracias a todos de antemano.
> Leonardo Espinosa
>
>
>

Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.493 / Virus Database: 292 - Release Date: 25/06/2003