VBA проверьте, является ли массив одномерным

Я понял, что мой оригинальный ответ можно упростить - вместо того вариант и SAFEARRAY структуры, определенные как типы VBA, все, что нужно, это несколько CopyMemorys, чтобы получить указатели и, наконец, результат целого.

вот самый простой полный 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

Я знаю, что вы хотите избежать использования обработчика ошибок, но если это достаточно хорошо для чипа Пирсона, это достаточно хорошо для меня. Этот код (а также ряд других очень полезных функций массив) можно найти на его сайте:

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

создать пользовательскую функцию:

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

Err.Clear

NumberOfArrayDimensions = Ndx - 1

End Function

для 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