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

У меня есть массив (который приходит из SQL) и потенциально может иметь одну или несколько строк.

Я хочу быть в состоянии выяснить, если массив имеет только одну строку.

UBound не кажется полезным. Для 2-мерных массивов UBound(A,1) а также UBound(A,2) возвращает количество строк и столбцов соответственно, но когда массив имеет только одну строку, UBound(A,1) возвращает количество столбцов и UBound(A,2) возвращает <Subscript out of range>,

Я также видел эту страницу справки Microsoft для определения количества измерений в массиве. Это очень ужасающее решение, которое включает использование обработчика ошибок.

Как я могу определить, есть ли в массиве только одна строка (надеюсь, без использования обработчика ошибок)?

Источник

7 ответов

Решение

Если вы действительно хотите избежать использования 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
Источник

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

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
Источник

Я понял, что мой первоначальный ответ может быть упрощен - вместо того, чтобы определять структуры VARIANT и 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
Источник

Для двумерного массива (или нескольких измерений) используйте эту функцию:

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
Источник

Я считаю, что принятый и пересмотренный ответ Блэкхокс очень поучителен, поэтому я поиграл с ним и узнал некоторые полезные вещи из него. Вот слегка измененная версия этого кода, в нижней части которой есть тестовая сабвуфер.

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
Источник

Идентификация однострочных массивов без обработки ошибок или функций API

«Я хочу иметь возможность выяснить, есть ли в массиве только одна строка».

Чтобы решить требование OP, сосредоточив внимание на массивах, уже имеющих размеры как массивы с 1 и 2 размерами, нет необходимости определять фактический размер массива, достаточно получить количество его «строк». Итак, я наткнулся на следующее удивительно простое решение, учитывая следующее:

  • Можно нарезать массивы 1-dim или 2-dim, чтобы изолировать их первый «столбец» через Application.Index(arr, 0, 1).
  • Возможный UBoundтеперь покажет правильное количество строк, особенно для случая с одной строкой.
      Function UBndOne(arr) As Long
'Purp: get rows count of (array) input
'Note: returns 1 as the function result for 
'    a) one-dimensional arrays 
'    b) 2-dim arrays with only one row
'      UBound(arr,1) isn't helpful for 1-dim array as it would return the number of elements
    UBndOne = UBound(Application.Index(arr, 0, 1))
End Function

Примечание: комбинированный код UBound(Application.Index(arr, 0, 1))может применяться даже к другим типам данных, кроме массивов, возвращая также 1как результат функции.

Источник

Не могли бы вы поместить массив в переменную диапазона через application.transpose, а затем получить количество строк и столбцов?

Источник
Другие вопросы по тегам