VBA检查数组是否是一维的
我有一个数组（来自SQL），可能有一个或多个行。
我想能够弄清楚数组是否只有一行。
UBound似乎没有帮助。 对于二维数组， UBound(A,1)和UBound(A,2)返回行数和列数，但是当数组只有一行时， UBound(A,1)返回列数和UBound(A,2)返回<Subscript out of range> 。
我也看到了这个微软帮助页面来确定数组中的维数。 这是一个非常可怕的解决scheme，涉及使用error handling程序。
我怎样才能确定数组是否只有一行（希望没有使用error handling程序）？
如果你真的想避免使用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
这是一个快速testingfunction来显示使用情况：
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
我意识到我的原始答案可以简化 – 而不是将VARIANT和SAFEARRAY结构定义为VBAtypes，所需的只是一些CopyMemory来获取指针，最后是整数结果。
这里是最简单的完整GetDims，通过内存中的variables直接检查维度：
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
我知道你想避免使用error handling程序，但是如果Chip Pearson足够好，那对我来说已经足够了。 这个代码（以及许多其他非常有用的数组函数）可以在他的网站上find：
http://www.cpearson.com/excel/vbaarrays.htm
创build一个自定义函数：
Function IsArrayOneDimensional(arr as Variant) As Boolean IsArrayOneDimensional = (NumberOfArrayDimensions(arr) = 1) End Function
哪个叫Chip的function：
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 NumberOfArrayDimensions = Ndx - 1 End 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
这使 ：
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