Question

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

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

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

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

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

Answer 1

如果你真的想避免使用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

这是一个快速测试功能，用于显示用法：

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

Answer 2

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

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

创建自定义函数：

Function IsArrayOneDimensional(arr as Variant) As Boolean
    IsArrayOneDimensional = (NumberOfArrayDimensions(arr) = 1)
End 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

Answer 3

我意识到我的original answer可以简化 - 而不是将VARIANT和SAFEARRAY结构定义为VBA类型，只需要几个CopyMemory s得到指针，最后是整数结果。

以下是最简单的完整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

Answer 4

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

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

给出：

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

Answer 5

我发现Blackhawks的接受程度和revised answer很有启发性，因此我尝试了一下并从中学习了一些有用的东西。这是该代码的略微修改版本，其底部包括一个测试子。

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

VBA检查数组是否为一维

5 个答案: