vba VBA检查数组是否为一维

VBA check if array is one dimensional

提问by Alec

I have an array (that comes from SQL) and can potentially have one or more rows.

我有一个数组（来自 SQL）并且可能有一行或多行。

I want to be able to figure out if the array has just one row.

我希望能够弄清楚数组是否只有一行。

UBound doesn't seem to be helpful. For 2-dimensional arrays UBound(A,1)and UBound(A,2)returns the number of rows and columns respectively, but when the array has only one row, UBound(A,1)returns the number of columns and UBound(A,2)returns a <Subscript out of range>.

UBound 似乎没有帮助。对于二维数组UBound(A,1)，分别UBound(A,2)返回行数和列数，但当数组只有一行时，UBound(A,1)返回列数并UBound(A,2)返回a <Subscript out of range>。

I have also seen this Microsoft help pagefor determining the number of dimensions in an array. It is a very horrifying solution that involves using the error handler.

我还看到了这个 Microsoft 帮助页面，用于确定数组中的维数。这是一个非常可怕的解决方案，涉及使用错误处理程序。

How can I determine whether the array has just one row (hopefully without using the error handler)?

如何确定数组是否只有一行（希望不使用错误处理程序）？

回答by Blackhawk

If you REALLY want to avoid using On Error, you can use knowledge of the SAFEARRAYand VARIANTstructures used to store arrays under the covers to extract the dimension information from where it's actually stored in memory. Place the following in a module called mdlSAFEARRAY

如果你真的想避免使用On Error，你可以使用SAFEARRAY和VARIANT结构的知识来存储数组，从它实际存储在内存中的位置提取维度信息。将以下内容放在名为的模块中mdlSAFEARRAY

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)

Private Type SAFEARRAY
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
End Type

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

Private Enum tagVARENUM
    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
    CopyMemory VarPtr(varArray.vt), VarPtr(VarSafeArray), 16&
    If varArray.vt And (tagVARENUM.VT_ARRAY Or tagVARENUM.VT_BYREF) Then
        CopyMemory VarPtr(lpSAFEARRAY), varArray.lpSAFEARRAY, 4&
        If Not lpSAFEARRAY = 0 Then
            CopyMemory VarPtr(sArr), lpSAFEARRAY, LenB(sArr)
            GetDims = sArr.cDims
        Else
            GetDims = 0  'The array is uninitialized
        End If
    Else
        GetDims = 0  'Not an array - might want an error instead
    End If
End Function

Here is a quick test function to show usage:

这是一个显示用法的快速测试函数：

Public Sub testdims()
    Dim anotherarr(1, 2, 3) As Byte
    Dim myarr() As Long
    Dim strArr() As String
    ReDim myarr(9)
    ReDim strArr(12)
    Debug.Print GetDims(myarr)
    Debug.Print GetDims(anotherarr)
    Debug.Print GetDims(strArr)
End Sub

回答by David Zemens

I know you want to avoid using the error handler, but if it's good enough for Chip Pearson, it's good enough for me. This code (as well as a number of other very helpful array functions) can be found on his site:

我知道您想避免使用错误处理程序，但如果它对 Chip Pearson 来说足够好，那么对我来说也足够了。可以在他的网站上找到此代码（以及许多其他非常有用的数组函数）：

http://www.cpearson.com/excel/vbaarrays.htm

http://www.cpearson.com/excel/vbaarrays.htm

Create a custom function:

创建自定义函数：

Function IsArrayOneDimensional(arr as Variant) As Boolean
    IsArrayOneDimensional = (NumberOfArrayDimensions(arr) = 1)
End Function

Which calls Chip's function:

其中调用Chip的函数：

Public Function NumberOfArrayDimensions(arr As Variant) As Integer
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' NumberOfArrayDimensions
' This function returns the number of dimensions of an array. An unallocated dynamic array
' has 0 dimensions. This condition can also be tested with IsArrayEmpty.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Integer
Dim Res As Integer
On Error Resume Next
' Loop, increasing the dimension index Ndx, until an error occurs.
' An error will occur when Ndx exceeds the number of dimension
' in the array. Return Ndx - 1.
Do
    Ndx = Ndx + 1
    Res = UBound(arr, Ndx)
Loop Until Err.Number <> 0

Err.Clear

NumberOfArrayDimensions = Ndx - 1

End Function

回答by Blackhawk

I realized that my original answercan be simplified - rather than having the VARIANTand SAFEARRAYstructures defined as VBA Types, all that is needed is a few CopyMemorys to get the pointers and finally the Integer result.

我意识到可以简化我的原始答案- 而不是将VARIANT和SAFEARRAY结构定义为 VBA 类型，所需要的只是几个CopyMemorys 来获取指针，最后是 Integer 结果。

Here is the simplest complete GetDims that checks the dimensions directly through the variables in memory:

这是最简单的完整 GetDims，它直接通过内存中的变量检查维度：

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)

Public Function GetDims(VarSafeArray As Variant) As Integer
    Dim variantType As Integer
    Dim pointer As Long
    Dim arrayDims As Integer

    CopyMemory VarPtr(variantType), VarPtr(VarSafeArray), 2& 'the first 2 bytes of the VARIANT structure contain the type

    If (variantType And &H2000) > 0 Then 'Array (&H2000)
        'If the Variant contains an array or ByRef array, a pointer for the SAFEARRAY or array ByRef variant is located at VarPtr(VarSafeArray) + 8
        CopyMemory VarPtr(pointer), VarPtr(VarSafeArray) + 8, 4&

        'If the array is ByRef, there is an additional layer of indirection through another Variant (this is what allows ByRef calls to modify the calling scope).
        'Thus it must be dereferenced to get the SAFEARRAY structure
        If (variantType And &H4000) > 0 Then 'ByRef (&H4000)
            'dereference the pointer to pointer to get the actual pointer to the SAFEARRAY
            CopyMemory VarPtr(pointer), pointer, 4&
        End If
        'The pointer will be 0 if the array hasn't been initialized
        If Not pointer = 0 Then
            'If it HAS been initialized, we can pull the number of dimensions directly from the pointer, since it's the first member in the SAFEARRAY struct
            CopyMemory VarPtr(arrayDims), pointer, 2&
            GetDims = arrayDims
        Else
            GetDims = 0 'Array not initialized
        End If
    Else
        GetDims = 0 'It's not an array... Type mismatch maybe?
    End If
End Function

回答by z??

For a 2D array (or more dimensions), use this function:

对于二维数组（或更多维度），请使用此函数：

Function is2d(a As Variant) As Boolean
    Dim l As Long
    On Error Resume Next
    l = LBound(a, 2)
    is2d = Err = 0
End Function

which gives :

这使 ：

Sub test()
    Dim d1(2) As Integer, d2(2, 2) As Integer,d3(2, 2, 2) As Integer
    Dim b1, b2, b3 As Boolean

    b1 = is2d(d1) ' False
    b2 = is2d(d2) ' True
    b3 = is2d(d3) ' True

    Stop
End Sub

回答by Egalth

I found Blackhawks's accepted and revised answervery instructive, so I played around with it and learned some useful things from it. Here's a slightly modified version of that code that includes a test sub at the bottom.

我发现 Blackhawks 接受和修改的答案非常有启发性，所以我玩弄了它并从中学到了一些有用的东西。这是该代码的略微修改版本，在底部包含一个测试子。

Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
    ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)

Public Function GetDims(VarSafeArray As Variant) As Integer
    Dim variantType As Integer
    Dim pointer As Long
    Dim arrayDims As Integer

    'The first 2 bytes of the VARIANT structure contain the type:
    CopyMemory VarPtr(variantType), VarPtr(VarSafeArray), 2&

    If Not (variantType And &H2000) > 0 Then
    'It's not an array. Raise type mismatch.
        Err.Raise (13)
    End If

    'If the Variant contains an array or ByRef array, a pointer for the _
        SAFEARRAY or array ByRef variant is located at VarPtr(VarSafeArray) + 8:
    CopyMemory VarPtr(pointer), VarPtr(VarSafeArray) + 8, 4&

    'If the array is ByRef, there is an additional layer of indirection through_
    'another Variant (this is what allows ByRef calls to modify the calling scope).
    'Thus it must be dereferenced to get the SAFEARRAY structure:
    If (variantType And &H4000) > 0 Then 'ByRef (&H4000)
        'dereference the pointer to pointer to get actual pointer to the SAFEARRAY
        CopyMemory VarPtr(pointer), pointer, 4&
    End If
    'The pointer will be 0 if the array hasn't been initialized
    If Not pointer = 0 Then
        'If it HAS been initialized, we can pull the number of dimensions directly _
            from the pointer, since it's the first member in the SAFEARRAY struct:
        CopyMemory VarPtr(arrayDims), pointer, 2&
        GetDims = arrayDims
    Else
        GetDims = 0 'Array not initialized
    End If
End Function

Sub TestGetDims()
' Tests GetDims(). Should produce the following output to Immediate Window:
'
' 1             One
' 2             Two
' Number of array dimensions: 2

    Dim myArray(2, 2) As Variant
    Dim iResult As Integer
    myArray(0, 0) = 1
    myArray(1, 0) = "One"
    myArray(0, 1) = 2
    myArray(1, 1) = "Two"

    Debug.Print myArray(0, 0), myArray(1, 0)
    Debug.Print myArray(0, 1), myArray(1, 1)

    iResult = GetDims(myArray)

    Debug.Print "Number of array dimensions: " & iResult
End Sub