如何返回在 VBA 中传递给它的（变体）变量的维数

How to return the number of dimensions of a (Variant) variable passed to it in VBA

提问by user533978

Does anyone know how to return the number of dimensions of a (Variant) variable passed to it in VBA?

有谁知道如何返回在 VBA 中传递给它的（变体）变量的维数？

回答by Jacob

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

That's the only way I could come up with. Not pretty….

这是我能想到的唯一方法。不漂亮…。

Looking at MSDN, they basically did the same.

看看MSDN，他们基本上做了同样的事情。

回答by Florent B.

To return the number of dimensions without swallowing errors:

要返回没有吞下错误的维数：

#If VBA7 Then
  Private Type Pointer: Value As LongPtr: End Type
  Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (ByRef dest As Any, ByRef src As Any, ByVal Size As LongPtr)
#Else
  Private Type Pointer: Value As Long: End Type
  Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (ByRef dest As Any, ByRef src As Any, ByVal Size As Long)
#End If

Private Type TtagVARIANT
    vt As Integer
    r1 As Integer
    r2 As Integer
    r3 As Integer
    sa As Pointer
End Type


Public Function GetDims(source As Variant) As Integer
    Dim va As TtagVARIANT
    RtlMoveMemory va, source, LenB(va)                                            ' read tagVARIANT              '
    If va.vt And &H2000 Then Else Exit Function                                   ' exit if not an array         '
    If va.vt And &H4000 Then RtlMoveMemory va.sa, ByVal va.sa.Value, LenB(va.sa)  ' read by reference            '
    If va.sa.Value Then RtlMoveMemory GetDims, ByVal va.sa.Value, 2               ' read cDims from tagSAFEARRAY '
End Function

Usage:

用法：

Sub Examples()

    Dim list1
    Debug.Print GetDims(list1)    ' >> 0  '

    list1 = Array(1, 2, 3, 4)
    Debug.Print GetDims(list1)    ' >> 1  '

    Dim list2()
    Debug.Print GetDims(list2)    ' >> 0  '

    ReDim list2(2)
    Debug.Print GetDims(list2)    ' >> 1  '

    ReDim list2(2, 2)
    Debug.Print GetDims(list2)    ' >> 2  '

    Dim list3(0 To 0, 0 To 0, 0 To 0)
    Debug.Print GetDims(list3)    ' >> 3  '

End Sub

回答by aevanko

For arrays, MS has a nice method that involves looping through until an error occurs.

对于数组，MS 有一个很好的方法，它涉及循环直到发生错误。

"This routine tests the array named Xarray by testing the LBound of each dimension. Using a For...Next loop, the routine cycles through the number of possible array dimensions, up to 60000, until an error is generated. Then the error handler takes the counter step that the loop failed on, subtracts one (because the previous one was the last one without an error), and displays the result in a message box...."

“此例程通过测试每个维度的 LBound 来测试名为 Xarray 的数组。使用 For...Next 循环，该例程循环遍历可能的数组维数，最多 60000，直到生成错误。然后是错误处理程序采取循环失败的计数器步骤，减去一（因为前一个是没有错误的最后一个），然后在消息框中显示结果......”

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

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

Cleaned-up version of code (decided to write as a function, not 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

回答by jtolle

@cularis and @Issun have perfectly adequate answers for the exact question asked. I'm going to question your question, though. Do you really have a bunch of arrays of unknown dimension count floating around? If you're working in Excel, the only situation where this should occur is a UDF where you might get passed either a 1-D array or a 2-D array (or a non-array), but nothing else.

@cularis 和@Issun 对所问的确切问题有完全足够的答案。不过，我要质疑你的问题。你真的有一堆未知维数的数组在浮动吗？如果您在 Excel 中工作，那么应该发生这种情况的唯一情况是 UDF，您可能会在其中传递一维数组或二维数组（或非数组），但仅此而已。

You should almost never have a routine that expects something arbitrary though. And thus you probably shouldn't have a general "find # of array dimensions" routine either.

你几乎永远不应该有一个期望随意的例程。因此，您可能也不应该有一个通用的“查找数组维数”例程。

So, with that in mind, here is the routines I use:

因此，考虑到这一点，这是我使用的例程：

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

Note the link to Chip Pearson's excellent web site: http://www.cpearson.com/excel/VBAArrays.htm

请注意 Chip Pearson 优秀网站的链接：http: //www.cpearson.com/excel/VBAArrays.htm

Also see: How do I determine if an array is initialized in VB6?. I personally don't like the undocumented behavior it relies on, and performance is rarely that important in the Excel VBA code I'm writing, but it's interesting nonetheless.

另请参阅：如何确定数组是否在 VB6 中初始化？. 我个人不喜欢它所依赖的未记录的行为，而且性能在我编写的 Excel VBA 代码中很少那么重要，但它仍然很有趣。

回答by Blackhawk

Microsoft has documented the structure of VARIANT and SAFEARRAY, and using those you can parse the binary data to get the dimensions.

Microsoft 已经记录了 VARIANT 和 SAFEARRAY 的结构，并使用它们可以解析二进制数据以获取维度。

Create a normal code module. I call mine "mdlDims". You would use it by calling the simple function 'GetDims' and passing it an array.

创建一个普通的代码模块。我称我的为“mdlDims”。您可以通过调用简单的函数“GetDims”并将其传递给数组来使用它。

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

回答by S Meaden

I presume you mean without using On Error Resume Next which most programmers dislike and which also means that during debugging you can't use 'Break On All Errors' to get the code to stop dead (Tools->Options->General->Error Trapping->Break on All Errors).

我想你的意思是不使用大多数程序员不喜欢的 On Error Resume Next 这也意味着在调试期间你不能使用“Break On All Errors”来让代码停止运行（工具->选项->常规->错误捕获-> 中断所有错误）。

For me one solution is to bury any On Error Resume Next into a compiled DLL, in the old days this would have been VB6. Today you could use VB.NET but I choose to use C#.

对我来说，一种解决方案是将任何 On Error Resume Next 埋入已编译的 DLL 中，在过去，这将是 VB6。今天你可以使用 VB.NET，但我选择使用 C#。

If Visual Studio is available to you then here is some source. It will return a dictionary, the Dicitionary.Count will return the number of dimensions. The items will also contain the LBound and UBound as a concatenated string. I'm always querying an array not just for its dimensions but also for LBound and UBound of those dimensions so I put these together and return a whole bundle of info in a Scripting Dictionary

如果您可以使用 Visual Studio，那么这里有一些来源。它将返回一个字典，Dicitionary.Count 将返回维数。这些项目还将包含 LBound 和 UBound 作为连接字符串。我总是在查询一个数组，不仅是它的维度，还有那些维度的 LBound 和 UBound，所以我把它们放在一起，并在脚本字典中返回一整套信息

Here is C# source, start a Class Library calling it BuryVBAErrorsCS, set ComVisible(true) add a reference to COM library 'Microsoft Scripting Runtime', Register for Interop.

这是 C# 源代码，启动一个名为 BuryVBAErrorsCS 的类库，设置 ComVisible(true) 添加对 COM 库“Microsoft Scripting Runtime”的引用，注册互操作。

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;
        }
    }
}

For Excel client VBA code here is some source

对于 Excel 客户端 VBA 代码，这里有一些来源

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 WELL: This answer handles grid variants pulled off a worksheet with Range.Value as well as arrays created in code using Dim s(1) etc.! Some of the other answers do not do this.

注意：此答案处理从工作表中提取的网格变体，其中包含 Range.Value 以及使用 Dim s(1) 等在代码中创建的数组！其他一些答案没有这样做。

回答by Emeka Eya

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

回答by This Guy

I found a pretty simple way to check, probably laden with a bunch of coding faux pas, incorrect lingo, and ill advised techniques but never the less:

我找到了一种非常简单的检查方法，可能充满了大量的编码失礼、不正确的行话和不明智的技术，但绝不会少：

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 will obviously return a negative number if Var(0) doesn't exist. VarCount is the max reference number for use with Var(i), i is the number of variants you have.

注意：如果 Var(0) 不存在， VarCount 显然会返回一个负数。VarCount 是用于 Var(i) 的最大参考数，i 是您拥有的变体数。

回答by Nils

What about just using ubound(var) + 1? That should give you the last element of most of variables (unless it's a custom range, but in that case you should know that info already). The range of a conventional variable (for instance, when using the split function) starts with 0; ubound gives you the last item of the variable. So if you have a variable with 8 elements, for instance, it will go from 0 (lbound) to 7 (ubound), and you can know the quantity of elements just adding ubound(var) + 1. For example:

只使用 ubound(var) + 1 怎么样？这应该为您提供大多数变量的最后一个元素（除非它是自定义范围，但在这种情况下您应该已经知道该信息）。常规变量的范围（例如，使用 split 函数时）从 0 开始；ubound 为您提供变量的最后一项。因此，例如，如果您有一个包含 8 个元素的变量，它将从 0 (lbound) 变为 7 (ubound)，并且您只需添加 ubound(var) + 1 即可知道元素的数量。例如：

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

It will print this output to the Inmediate window:
First element: 0
Last element: 7
Quantity of elements: 8

它将将此输出打印到中间窗口：
第一个元素：0
最后一个元素：7
元素数量：8

Also, if you are not sure that the first element (lbound) is 0, you can just use:

此外，如果您不确定第一个元素 (lbound) 是否为 0，则可以使用：

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

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