excel - vectores - Cómo devolver el número de dimensiones de una variable(Variante) que se le pasó en VBA

ubound vba

Question

¿Alguien sabe cómo devolver el número de dimensiones de una variable (Variante) que se le pasó en VBA?

Answer 1

¿Qué tal si usamos ubound (var) + 1? Eso debería darte el último elemento de la mayoría de las variables (a menos que sea un rango personalizado, pero en ese caso ya deberías conocer esa información). El rango de una variable convencional (por ejemplo, cuando se usa la función dividida) comienza con 0; Ubound te proporciona el último elemento de la variable. Entonces, si tienes una variable con 8 elementos, por ejemplo, irá de 0 (lbound) a 7 (ubound), y puedes saber la cantidad de elementos que acaban de agregar ubound (var) + 1. Por ejemplo:

Public Sub PrintQntElements()
Dim str As String
Dim var As Variant
Dim i As Integer
str = "Element1!Element2!Element3!Element4!Element5!Element6!Element7!Element8"
var = Split(str, "!")
i = UBound(var) + 1
Debug.Print "First element: " & LBound(var)
Debug.Print "Last element: " & UBound(var)
Debug.Print "Quantity of elements: " & i
End Sub

Imprimirá esta salida en la ventana Inmediato:
Primer elemento: 0
Último elemento: 7
Cantidad de elementos: 8

Además, si no está seguro de que el primer elemento (lbound) sea 0, puede usar:

i = UBound (var) - LBound (var) + 1

Answer 2

@cularis y @Issun tienen respuestas perfectamente adecuadas para la pregunta exacta. Sin embargo, voy a cuestionar tu pregunta. ¿Realmente tienes un grupo de matrices de recuento de dimensiones desconocidas flotando? Si está trabajando en Excel, la única situación donde esto debería ocurrir es un UDF en el que se le puede pasar una matriz 1-D o una matriz 2-D (o una matriz que no sea una matriz), pero nada más.

Casi nunca deberías tener una rutina que espere algo arbitrario. Y por lo tanto, probablemente tampoco deba tener una rutina general de "encontrar un número de dimensiones de matriz".

Entonces, con eso en mente, aquí están las rutinas que uso:

Global Const ERR_VBA_NONE& = 0
Global Const ERR_VBA_SUBSCRIPT_OUT_OF_RANGE& = 9
''Tests an array to see if it extends to a given dimension
Public Function arrHasDim(arr, dimNum As Long) As Boolean
Debug.Assert IsArray(arr)
Debug.Assert dimNum > 0
''Note that it is possible for a VBA array to have no dimensions (i.e.
''''LBound'' raises an error even on the first dimension). This happens
''with "unallocated" (borrowing Chip Pearson''s terminology; see
''http://www.cpearson.com/excel/VBAArrays.htm) dynamic arrays -
''essentially arrays that have been declared with ''Dim arr()'' but never
''sized with ''ReDim'', or arrays that have been deallocated with ''Erase''.
On Error Resume Next
Dim lb As Long
lb = LBound(arr, dimNum)
''No error (0) - array has given dimension
''Subscript out of range (9) - array doesn''t have given dimension
arrHasDim = (Err.Number = ERR_VBA_NONE)
Debug.Assert (Err.Number = ERR_VBA_NONE Or Err.Number = ERR_VBA_SUBSCRIPT_OUT_OF_RANGE)
On Error GoTo 0
End Function
''"vect" = array of one and only one dimension
Public Function isVect(arg) As Boolean
If IsObject(arg) Then
Exit Function
End If
If Not IsArray(arg) Then
Exit Function
End If
If arrHasDim(arg, 1) Then
isVect = Not arrHasDim(arg, 2)
End If
End Function
''"mat" = array of two and only two dimensions
Public Function isMat(arg) As Boolean
If IsObject(arg) Then
Exit Function
End If
If Not IsArray(arg) Then
Exit Function
End If
If arrHasDim(arg, 2) Then
isMat = Not arrHasDim(arg, 3)
End If
End Function

Tenga en cuenta el enlace al excelente sitio web de Chip Pearson: http://www.cpearson.com/excel/VBAArrays.htm

Ver también: ¿Cómo puedo determinar si una matriz se inicializa en VB6? . Personalmente, no me gusta el comportamiento indocumentado del que depende, y el rendimiento rara vez es tan importante en el código de Excel VBA que estoy escribiendo, pero de todos modos es interesante.

Answer 3

Encontré una manera bastante simple de verificar, probablemente cargada con un montón de falsa pas de codificación, jerga incorrecta y técnicas desacertadas, pero nunca menos:

Dim i as Long
Dim VarCount as Long
Dim Var as Variant
''generate your variant here
i = 0
VarCount = 0
recheck1:
If IsEmpty(Var(i)) = True Then GoTo VarCalc
i = i + 1
GoTo recheck1
VarCalc:
VarCount= i - 1

Nota: VarCount obviamente devolverá un número negativo si Var (0) no existe. VarCount es el número de referencia máximo para usar con Var (i), i es el número de variantes que tiene.

Answer 4

Microsoft ha documentado la estructura de VARIANT y SAFEARRAY, y al usarlas puede analizar los datos binarios para obtener las dimensiones.

Crea un módulo de código normal. Yo llamo al mío "mdlDims". Lo usarías llamando a la función simple ''GetDims'' y pasando una matriz.

Option Compare Database
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (var() As Any) As Long
''http://msdn.microsoft.com/en-us/library/windows/desktop/ms221482(v=vs.85).aspx
Private Type SAFEARRAY
cDims As Integer
fFeatures As Integer
cbElements As Long
cLocks As Long
pvData As Long
End Type
''Variants are all 16 bytes, but they are split up differently based on the contained type
''VBA doesn''t have the ability to Union, so a Type is limited to representing one layout
''http://msdn.microsoft.com/en-us/library/windows/desktop/ms221627(v=vs.85).aspx
Private Type ARRAY_VARIANT
vt As Integer
wReserved1 As Integer
wReserved2 As Integer
wReserved3 As Integer
lpSAFEARRAY As Long
data(4) As Byte
End Type
''http://msdn.microsoft.com/en-us/library/windows/desktop/ms221170(v=vs.85).aspx
Private Enum VARENUM
VT_EMPTY = &H0
VT_NULL
VT_I2
VT_I4
VT_R4
VT_R8
VT_CY
VT_DATE
VT_BSTR
VT_DISPATCH
VT_ERROR
VT_BOOL
VT_VARIANT
VT_UNKNOWN
VT_DECIMAL
VT_I1 = &H10
VT_UI1
VT_UI2
VT_I8
VT_UI8
VT_INT
VT_VOID
VT_HRESULT
VT_PTR
VT_SAFEARRAY
VT_CARRAY
VT_USERDEFINED
VT_LPSTR
VT_LPWSTR
VT_RECORD = &H24
VT_INT_PTR
VT_UINT_PTR
VT_ARRAY = &H2000
VT_BYREF = &H4000
End Enum
Public Function GetDims(VarSafeArray As Variant) As Integer
Dim varArray As ARRAY_VARIANT
Dim lpSAFEARRAY As Long
Dim sArr As SAFEARRAY
''Inspect the Variant
CopyMemory VarPtr(varArray.vt), VarPtr(VarSafeArray), 16&
''If the Variant is pointing to an array...
If varArray.vt And (VARENUM.VT_ARRAY Or VARENUM.VT_BYREF) Then
''Get the pointer to the SAFEARRAY from the Variant
CopyMemory VarPtr(lpSAFEARRAY), varArray.lpSAFEARRAY, 4&
''If the pointer is not Null
If Not lpSAFEARRAY = 0 Then
''Read the array dimensions from the SAFEARRAY
CopyMemory VarPtr(sArr), lpSAFEARRAY, LenB(sArr)
''and return them
GetDims = sArr.cDims
Else
''The array is uninitialized
GetDims = 0
End If
Else
''Not an array, you could choose to raise an error here
GetDims = 0
End If
End Function

Answer 5

Para devolver el número de dimensiones sin errores de deglución:

Private Declare PtrSafe Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" ( _
ByRef dest As Any, ByVal src As LongPtr, ByVal size As LongPtr)
Public Function GetDimensions(source As Variant) As Integer
Dim vt As Long, ptr As LongPtr
memcpy vt, VarPtr(source), 2 '' read the variant type (2 bytes) ''
If (vt And &H2000) = 0 Then Exit Function '' return 0 if not an array ''
memcpy ptr, VarPtr(source) + 8, Len(ptr) '' read the variant data at offset 8 ''
If (vt And &H4000) Then memcpy ptr, ptr, Len(ptr) '' read by reference if the data is a reference ''
If ptr Then memcpy GetDimensions, ptr, 2 '' read the number of dimensions at offset 0 (2 bytes) ''
End Function

Uso:

Sub Examples()
Dim list1
Debug.Print GetDimensions(list1) '' >> 0 ''
list1 = Array(1, 2, 3, 4)
Debug.Print GetDimensions(list1) '' >> 1 ''
Dim list2()
Debug.Print GetDimensions(list2) '' >> 0 ''
ReDim list2(2)
Debug.Print GetDimensions(list2) '' >> 1 ''
ReDim list2(2, 2)
Debug.Print GetDimensions(list2) '' >> 2 ''
End Sub

Answer 6

Para las matrices, MS tiene un buen método que involucra el bucle hasta que ocurre un error.

"Esta rutina prueba la matriz denominada Xarray probando el LBound de cada dimensión. Usando un ciclo For ... Next, la rutina recorre el número de posibles dimensiones de la matriz, hasta 60000, hasta que se genera un error. toma el contrapasado en el que falló el ciclo, resta uno (porque el anterior fue el último sin error) y muestra el resultado en un cuadro de mensaje .... "

http://support.microsoft.com/kb/152288

Versión limpiada del código (decidió escribir como una función, no como sub):

Function NumberOfDimensions(ByVal vArray As Variant) As Long
Dim dimnum As Long
On Error GoTo FinalDimension
For dimnum = 1 To 60000
ErrorCheck = LBound(vArray, dimnum)
Next
FinalDimension:
NumberOfDimensions = dimnum - 1
End Function

Answer 7

Supongo que quiere decir sin usar On Error Resume Next que a la mayoría de los programadores no le gusta y que también significa que durante la depuración no puede usar ''Break On All Errors'' para que el código se detenga (Tools-> Options-> General-> Error Trapping-> Break on All Errors).

Para mí, una solución es enterrar cualquier Curriculum en caso de error siguiente en una DLL compilada, en los viejos tiempos esto habría sido VB6. Hoy podrías usar VB.NET pero elijo usar C #.

Si Visual Studio está disponible para usted, aquí hay alguna fuente. Devolverá un diccionario, el Dicitionary.Count devolverá el número de dimensiones. Los elementos también contendrán LBound y UBound como una cadena concatenada. Siempre estoy consultando una matriz no solo por sus dimensiones, sino también por LBound y UBound de esas dimensiones, así que las reúno y devuelvo todo un paquete de información en un diccionario de scripts.

Aquí está la fuente de C #, inicie una Biblioteca de clases llamándola BuryVBAErrorsCS, establezca ComVisible (verdadero) y añada una referencia a la biblioteca COM ''Microsoft Scripting Runtime'', Register for Interop.

using Microsoft.VisualBasic;
using System;
using System.Runtime.InteropServices;
namespace BuryVBAErrorsCS
{
// Requires adding a reference to COM library Microsoft Scripting Runtime
// In AssemblyInfo.cs set ComVisible(true);
// In Build tab check ''Register for Interop''
public interface IDimensionsAndBounds
{
Scripting.Dictionary DimsAndBounds(Object v);
}
[ClassInterface(ClassInterfaceType.None)]
[ComDefaultInterface(typeof(IDimensionsAndBounds))]
public class CDimensionsAndBounds : IDimensionsAndBounds
{
public Scripting.Dictionary DimsAndBounds(Object v)
{
Scripting.Dictionary dicDimsAndBounds;
dicDimsAndBounds = new Scripting.Dictionary();
try
{
for (Int32 lDimensionLoop = 1; lDimensionLoop < 30; lDimensionLoop++)
{
long vLBound = Information.LBound((Array)v, lDimensionLoop);
long vUBound = Information.UBound((Array)v, lDimensionLoop);
string concat = (string)vLBound.ToString() + " " + (string)vUBound.ToString();
dicDimsAndBounds.Add(lDimensionLoop, concat);
}
}
catch (Exception)
{
}
return dicDimsAndBounds;
}
}
}

Para el código de VBA del cliente de Excel aquí hay alguna fuente

Sub TestCDimensionsAndBounds()
''* requires Tools->References->BuryVBAErrorsCS.tlb
Dim rng As Excel.Range
Set rng = ThisWorkbook.Worksheets.Item(1).Range("B4:c7")
Dim v As Variant
v = rng.Value2
Dim o As BuryVBAErrorsCS.CDimensionsAndBounds
Set o = New BuryVBAErrorsCS.CDimensionsAndBounds
Dim dic As Scripting.Dictionary
Set dic = o.DimsAndBounds(v)
Debug.Assert dic.Items()(0) = "1 4"
Debug.Assert dic.Items()(1) = "1 2"
Dim s(1 To 2, 2 To 3, 3 To 4, 4 To 5, 5 To 6)
Set dic = o.DimsAndBounds(s)
Debug.Assert dic.Items()(0) = "1 2"
Debug.Assert dic.Items()(1) = "2 3"
Debug.Assert dic.Items()(2) = "3 4"
Debug.Assert dic.Items()(3) = "4 5"
Debug.Assert dic.Items()(4) = "5 6"
Stop
End Sub

NOTA BIEN : Esta respuesta maneja las variantes de la cuadrícula extraídas de una hoja de trabajo con Range.Value así como las matrices creadas en código usando Dim s (1), etc. Algunas de las otras respuestas no hacen esto.

Answer 8

Function ArrayDimension(ByRef ArrayX As Variant) As Byte
Dim i As Integer, a As String, arDim As Byte
On Error Resume Next
i = 0
Do
a = CStr(ArrayX(0, i))
If Err.Number > 0 Then
arDim = i
On Error GoTo 0
Exit Do
Else
i = i + 1
End If
Loop
If arDim = 0 Then arDim = 1
ArrayDimension = arDim
End Function

Answer 9

Function getDimension(var As Variant) As Long
On Error GoTo Err
Dim i As Long
Dim tmp As Long
i = 0
Do While True
i = i + 1
tmp = UBound(var, i)
Loop
Err:
getDimension = i - 1
End Function

Esa es la única forma en que puedo pensar. No es bonito….

En cuanto a MSDN, básicamente hicieron lo mismo.