Comment retourner le nombre de dimensions d'une variable (variante) qui lui est transmise en VBA
est-ce que quelqu'un sait rendre le nombre de dimensions d'une variable (variante) qui lui est transmise en VBA?
9 réponses
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
C'est le seul moyen que j'ai trouvé. Pas joli....
en regardant MSDN, ils ont fait la même chose.
pour retourner le nombre de dimensions sans erreurs de déglutition:
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
Utilisation:
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
@cularis et @Issun ont des réponses parfaitement adéquates à la question posée. Je vais remettre en question votre question. Avez-vous vraiment un tas de tableaux de dimension inconnue qui flottent autour? Si vous travaillez dans Excel, la seule situation où cela devrait se produire est un UDF où vous pourriez passer soit un tableau 1-D ou un tableau 2-D (ou un non-tableau), mais rien d'autre.
vous ne devriez presque jamais avoir une routine qui attend quelque chose d'arbitraire bien. Et donc vous ne devriez probablement pas avoir non plus une routine générale de "trouver # des dimensions du tableau".
donc, avec cela à l'esprit, voici les routines que j'utilise:
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
Notez le lien vers L'excellent site Web de Chip Pearson: http://www.cpearson.com/excel/VBAArrays.htm
Voir aussi: Comment puis-je déterminer si un tableau est initialisé dans VB6? . Personnellement, je n'aime pas l' un comportement non documenté sur lequel il repose, et la performance est rarement aussi important dans le Code Excel VBA que j'écris, mais il est intéressant néanmoins.
pour les tableaux, MS a une méthode agréable qui implique une boucle à travers jusqu'à ce qu'une erreur se produit.
"Cette routine tests le tableau nommé Xarray en testant la LBound de chaque dimension. À l'aide d'une Pour...La boucle suivante, la routine tourne à travers le nombre de dimensions possibles du tableau, jusqu'à 60000, jusqu'à ce qu'une erreur soit générée. Puis le gestionnaire d'erreurs prend la contre-mesure sur laquelle la boucle a échoué, en soustrait une (parce que la précédente était la dernière sans erreur), et affiche le résultat dans une boîte de message...."
http://support.microsoft.com/kb/152288
version nettoyée du code (a décidé d'écrire comme une fonction, pas 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
Microsoft a documenté la structure de VARIANT et SAFEARRAY, et en utilisant ceux que vous pouvez analyser les données binaires pour obtenir les dimensions.
créer un module de code normal. J'appelle le mien "mdlDims". Vous l'utiliseriez en appelant la simple fonction 'GetDims' et en lui passant un tableau.
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
je suppose que vous voulez dire sans utiliser sur le Resume D'erreur suivant ce que la plupart des programmeurs n'aiment pas et qui signifie aussi que pendant le débogage vous ne pouvez pas utiliser 'Break sur toutes les erreurs' pour obtenir le code pour arrêter dead (Outils->Options->General->Error Trapping->Break sur toutes les erreurs).
pour moi une solution est d'enterrer n'importe quelle Sur la reprise D'erreur prochaine dans une DLL compilée, dans les vieux jours cela aurait été VB6. Aujourd'hui, vous pourriez utiliser VB.NET mais je choisis D'utiliser C#.
si Visual Studio est à votre disposition alors voici quelques sources. Il retournera un dictionnaire, le Dicitionnaire.Le compte retournera le nombre de dimensions. Les items contiendront également le LBound et UBound sous forme de chaîne concaténée. Je suis toujours en train de questionner un tableau non seulement pour ses dimensions, mais aussi pour LBound et UBound de ces dimensions donc je les ai mis ensemble et je renvoie un paquet entier d'information dans un dictionnaire de script
Voici C # source, démarrer une bibliothèque de classe l'appelant BuryVBAErrorsCS, set ComVisible (true) ajouter une référence à la bibliothèque COM "Microsoft Scripting Runtime", Enregistrer pour 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;
}
}
}
Pour le client Excel VBA code ici est un peu de la source
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
NOTE bien : cette réponse traite des variantes de grille tirées d'une feuille de travail avec portée.Valeur aussi bien que tableaux créés en code en utilisant Dim s(1) etc.! Certaines autres réponses ne le font pas.
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
j'ai trouvé un moyen assez simple de vérifier, probablement chargé d'un tas de faux pas de codage, un jargon incorrect, et des techniques mal conseillées, mais jamais le moins:
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
Note: VarCount retournera évidemment un nombre négatif si Var(0) n'existe pas. VarCount est le numéro de référence max pour L'utilisation avec Var (i), i est le nombre de variantes que vous avez.
Qu'en est-il de l'utilisation d'ubound(var) + 1? Cela devrait vous donner le dernier élément de la plupart des variables (à moins que ce soit une plage personnalisée, mais dans ce cas, vous devriez déjà connaître cette information). La plage d'une variable conventionnelle (par exemple, en utilisant la fonction split) commence par 0; ubound vous donne le dernier élément de la variable. Donc, si vous avez une variable avec 8 éléments, par exemple, elle passera de 0 (lbound) à 7 (ubound), et vous pouvez connaître la quantité d'éléments juste en ajoutant ubound (var) + 1. Par exemple:
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
il imprimera cette sortie dans la fenêtre Inmediate:
Premier élément: 0
Dernier élément: 7
Quantité d'Éléments: 8
Aussi, si vous n'êtes pas sûr que le premier élément (lbound) est 0, vous pouvez simplement utiliser:
i = UBound (var) - LBound (var) + 1