programing

VBA에서 전달된 (변수) 변수의 차원 수를 반환하는 방법

powerit 2023. 5. 13. 11:03
반응형

VBA에서 전달된 (변수) 변수의 차원 수를 반환하는 방법

VBA로 전달된 (변수) 변수의 차원 수를 반환하는 방법을 아는 사람이 있습니까?

Function getDimension(var As Variant) As Long
    On Error GoTo Err
    Dim i As Long
    Dim tmp As Long
    i = 0
    Do While True
        i = i + 1
        tmp = UBound(var, i)
    Loop
Err:
    getDimension = i - 1
End Function

그게 제가 생각해낼 수 있는 유일한 방법입니다.예쁘지도 않고…

MSDN을 보면, 그들은 기본적으로 같은 일을 했습니다.

오류를 삼키지 않고 치수 수를 반환하려면:

#If VBA7 Then
  Private Type Pointer: Value As LongPtr: End Type
  Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (ByRef dest As Any, ByRef src As Any, ByVal Size As LongPtr)
#Else
  Private Type Pointer: Value As Long: End Type
  Private Declare Sub RtlMoveMemory Lib "kernel32.dll" (ByRef dest As Any, ByRef src As Any, ByVal Size As Long)
#End If

Private Type TtagVARIANT
    vt As Integer
    r1 As Integer
    r2 As Integer
    r3 As Integer
    sa As Pointer
End Type


Public Function GetDims(source As Variant) As Integer
    Dim va As TtagVARIANT
    RtlMoveMemory va, source, LenB(va)                                            ' read tagVARIANT              '
    If va.vt And &H2000 Then Else Exit Function                                   ' exit if not an array         '
    If va.vt And &H4000 Then RtlMoveMemory va.sa, ByVal va.sa.Value, LenB(va.sa)  ' read by reference            '
    If va.sa.Value Then RtlMoveMemory GetDims, ByVal va.sa.Value, 2               ' read cDims from tagSAFEARRAY '
End Function

용도:

Sub Examples()

    Dim list1
    Debug.Print GetDims(list1)    ' >> 0  '

    list1 = Array(1, 2, 3, 4)
    Debug.Print GetDims(list1)    ' >> 1  '

    Dim list2()
    Debug.Print GetDims(list2)    ' >> 0  '

    ReDim list2(2)
    Debug.Print GetDims(list2)    ' >> 1  '

    ReDim list2(2, 2)
    Debug.Print GetDims(list2)    ' >> 2  '

    Dim list3(0 To 0, 0 To 0, 0 To 0)
    Debug.Print GetDims(list3)    ' >> 3  '

End Sub

@cularis와 @Issun은 정확한 질문에 대한 완벽하게 적절한 답변을 가지고 있습니다.하지만 당신의 질문에 의문을 품겠습니다.알 수 없는 차원의 배열이 정말 많이 떠돌고 있습니까?Excel에서 작업하는 경우 이러한 상황이 발생해야 하는 유일한 상황은 1-D 배열 또는 2-D 배열(또는 비-배열)을 통과할 수 있는 UDF입니다.

하지만 여러분은 어떤 것을 임의적으로 기대하는 일상적인 일은 거의 해서는 안 됩니다.따라서 일반적인 "어레이 차원 수 찾기" 루틴도 사용해서는 안 됩니다.

이를 염두에 두고 제가 사용하는 루틴은 다음과 같습니다.

Global Const ERR_VBA_NONE& = 0
Global Const ERR_VBA_SUBSCRIPT_OUT_OF_RANGE& = 9

'Tests an array to see if it extends to a given dimension
Public Function arrHasDim(arr, dimNum As Long) As Boolean
    Debug.Assert IsArray(arr)
    Debug.Assert dimNum > 0

    'Note that it is possible for a VBA array to have no dimensions (i.e.
    ''LBound' raises an error even on the first dimension). This happens
    'with "unallocated" (borrowing Chip Pearson's terminology; see
    'http://www.cpearson.com/excel/VBAArrays.htm) dynamic arrays -
    'essentially arrays that have been declared with 'Dim arr()' but never
    'sized with 'ReDim', or arrays that have been deallocated with 'Erase'.

    On Error Resume Next
        Dim lb As Long
        lb = LBound(arr, dimNum)

        'No error (0) - array has given dimension
        'Subscript out of range (9) - array doesn't have given dimension
        arrHasDim = (Err.Number = ERR_VBA_NONE)

        Debug.Assert (Err.Number = ERR_VBA_NONE Or Err.Number = ERR_VBA_SUBSCRIPT_OUT_OF_RANGE)
    On Error GoTo 0
End Function

'"vect" = array of one and only one dimension
Public Function isVect(arg) As Boolean
    If IsObject(arg) Then
        Exit Function
    End If

    If Not IsArray(arg) Then
        Exit Function
    End If

    If arrHasDim(arg, 1) Then
        isVect = Not arrHasDim(arg, 2)
    End If
End Function

'"mat" = array of two and only two dimensions
Public Function isMat(arg) As Boolean
    If IsObject(arg) Then
        Exit Function
    End If

    If Not IsArray(arg) Then
        Exit Function
    End If

    If arrHasDim(arg, 2) Then
        isMat = Not arrHasDim(arg, 3)
    End If
End Function

Chip Pearson의 우수한 웹 사이트 링크: http://www.cpearson.com/excel/VBAArrays.htm

참고:배열이 VB6에서 초기화되었는지 확인하려면 어떻게 해야 합니까?저는 개인적으로 그것이 의존하는 문서화되지 않은 행동을 좋아하지 않으며, 제가 쓰고 있는 Excel VBA 코드에서 성능이 그렇게 중요한 경우는 거의 없지만, 그럼에도 불구하고 흥미롭습니다.

어레이의 경우 MS는 오류가 발생할 때까지 루프를 반복하는 좋은 방법을 사용합니다.

"이 루틴에서는 각 차원의 LBound를 테스트하여 Xarray라는 이름의 어레이를 테스트합니다.대상 사용...다음 루프에서는 오류가 발생할 때까지 가능한 어레이 차원 수를 최대 60000까지 순환합니다.그런 다음 오류 처리기는 루프가 실패한 카운터 단계를 수행하고 하나를 뺀 다음(이전 단계가 오류가 없는 마지막 단계였기 때문에) 메시지 상자에 결과를 표시합니다.."

http://support.microsoft.com/kb/152288

정리된 코드 버전(하위가 아닌 함수로 쓰기로 결정됨):

Function NumberOfDimensions(ByVal vArray As Variant) As Long

Dim dimnum As Long
On Error GoTo FinalDimension

For dimnum = 1 To 60000
    ErrorCheck = LBound(vArray, dimnum)
Next

FinalDimension:
    NumberOfDimensions = dimnum - 1

End Function

Microsoft는 VARIANT와 SAFARRAY의 구조를 문서화했으며, 이를 사용하여 이진 데이터를 구문 분석하여 치수를 얻을 수 있습니다.

일반 코드 모듈을 만듭니다.저는 "mdlDims"라고 부릅니다.간단한 함수를 'GetDims'라고 부르고 배열을 전달하여 사용할 수 있습니다.

Option Compare Database
Option Explicit

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Integer)
Private Declare Function VarPtrArray Lib "msvbvm60.dll" Alias "VarPtr" (var() As Any) As Long

'http://msdn.microsoft.com/en-us/library/windows/desktop/ms221482(v=vs.85).aspx
Private Type SAFEARRAY
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
End Type

'Variants are all 16 bytes, but they are split up differently based on the contained type
'VBA doesn't have the ability to Union, so a Type is limited to representing one layout
'http://msdn.microsoft.com/en-us/library/windows/desktop/ms221627(v=vs.85).aspx
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

'http://msdn.microsoft.com/en-us/library/windows/desktop/ms221170(v=vs.85).aspx
Private Enum VARENUM
    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

    'Inspect the Variant
    CopyMemory VarPtr(varArray.vt), VarPtr(VarSafeArray), 16&

    'If the Variant is pointing to an array...
    If varArray.vt And (VARENUM.VT_ARRAY Or VARENUM.VT_BYREF) Then

        'Get the pointer to the SAFEARRAY from the Variant
        CopyMemory VarPtr(lpSAFEARRAY), varArray.lpSAFEARRAY, 4&

        'If the pointer is not Null
        If Not lpSAFEARRAY = 0 Then
            'Read the array dimensions from the SAFEARRAY
            CopyMemory VarPtr(sArr), lpSAFEARRAY, LenB(sArr)

            'and return them
            GetDims = sArr.cDims
        Else
            'The array is uninitialized
            GetDims = 0
        End If
    Else
        'Not an array, you could choose to raise an error here
        GetDims = 0
    End If
End Function

대부분의 프로그래머가 싫어하는 On Error Resume Next를 사용하지 않고 디버깅 중에 Break On All Errors를 사용하여 코드를 정지시킬 수 없다는 것을 의미합니다(Tools->Options->General->Error Traping->Break on All Errors).

저에게 한 가지 해결책은 On Error Resume Next를 컴파일된 DLL에 저장하는 것입니다. 예전에는 VB6이었을 것입니다.오늘은 VB를 사용할 수 있습니다.NET 하지만 저는 C#을 사용하기로 선택했습니다.

Visual Studio를 사용할 수 있는 경우 몇 가지 소스가 있습니다.그것은 사전인 디비전을 반환할 것입니다.카운트는 차원 수를 반환합니다.항목에는 LBound 및 UBound가 연결된 문자열로 포함됩니다.어레이의 치수뿐만 아니라 해당 치수의 LBound 및 Ubound에 대해서도 항상 쿼리하므로 이를 함께 구성하고 스크립팅 사전에 전체 정보 번들을 반환합니다.

여기는 C# 소스입니다. 클래스 라이브러리를 시작합니다. 이름은 BurryVB입니다.AErrorsCS, set ComVisible(true)은 COM 라이브러리 'Microsoft 스크립팅 런타임'에 대한 참조를 추가합니다. Interop에 등록합니다.

using Microsoft.VisualBasic;
using System;
using System.Runtime.InteropServices;

namespace BuryVBAErrorsCS
{
    // Requires adding a reference to COM library Microsoft Scripting Runtime
    // In AssemblyInfo.cs set ComVisible(true);
    // In Build tab check 'Register for Interop'
    public interface IDimensionsAndBounds
    {
        Scripting.Dictionary DimsAndBounds(Object v);
    }

    [ClassInterface(ClassInterfaceType.None)]
    [ComDefaultInterface(typeof(IDimensionsAndBounds))]
    public class CDimensionsAndBounds : IDimensionsAndBounds
    {
        public Scripting.Dictionary DimsAndBounds(Object v)
        {
            Scripting.Dictionary dicDimsAndBounds;
            dicDimsAndBounds = new Scripting.Dictionary();

            try
            {
                for (Int32 lDimensionLoop = 1; lDimensionLoop < 30; lDimensionLoop++)
                {
                    long vLBound = Information.LBound((Array)v, lDimensionLoop);
                    long vUBound = Information.UBound((Array)v, lDimensionLoop);
                    string concat = (string)vLBound.ToString() + " " + (string)vUBound.ToString();
                    dicDimsAndBounds.Add(lDimensionLoop, concat);
                }
            }
            catch (Exception)
            {

            }

            return dicDimsAndBounds;
        }
    }
}

Excel 클라이언트의 VBA 코드는 다음과 같습니다.

Sub TestCDimensionsAndBounds()
    '* requires Tools->References->BuryVBAErrorsCS.tlb
    Dim rng As Excel.Range
    Set rng = ThisWorkbook.Worksheets.Item(1).Range("B4:c7")

    Dim v As Variant
    v = rng.Value2

    Dim o As BuryVBAErrorsCS.CDimensionsAndBounds
    Set o = New BuryVBAErrorsCS.CDimensionsAndBounds

    Dim dic As Scripting.Dictionary
    Set dic = o.DimsAndBounds(v)

    Debug.Assert dic.Items()(0) = "1 4"
    Debug.Assert dic.Items()(1) = "1 2"


    Dim s(1 To 2, 2 To 3, 3 To 4, 4 To 5, 5 To 6)
    Set dic = o.DimsAndBounds(s)
    Debug.Assert dic.Items()(0) = "1 2"
    Debug.Assert dic.Items()(1) = "2 3"
    Debug.Assert dic.Items()(2) = "3 4"
    Debug.Assert dic.Items()(3) = "4 5"
    Debug.Assert dic.Items()(4) = "5 6"


    Stop
End Sub

참고: 이 답변은 범위가 있는 워크시트에서 추출한 그리드 변형을 처리합니다.Dims(1) 등을 사용하여 코드로 생성된 배열뿐만 아니라 값도!다른 답변 중 일부는 이를 수행하지 않습니다.

오류가 발생하면 새 변수 값이 과금되지 않는다는 사실을 사용하고 싶습니다.

어레이(vArray)의 차원(A_Dim)을 가져오려면 다음 코드를 사용할 수 있습니다.

On Error Resume Next
    A_Dim = -1
    Do Until A = "X"
        A_Dim = A_Dim + 1
        A = "X"
        A = UBound(vArray, A_Dim + 1)
    Loop
On Error GoTo 0
Function ArrayDimension(ByRef ArrayX As Variant) As Byte
    Dim i As Integer, a As String, arDim As Byte
    On Error Resume Next
    i = 0
    Do
        a = CStr(ArrayX(0, i))
        If Err.Number > 0 Then
            arDim = i
            On Error GoTo 0
            Exit Do
        Else
             i = i + 1
        End If
    Loop
    If arDim = 0 Then arDim = 1
    ArrayDimension = arDim
End Function

저는 꽤 간단한 확인 방법을 찾았습니다. 아마도 코딩 가짜 파스, 잘못된 언어, 잘못된 기술로 가득 차 있을 것입니다. 하지만 그럼에도 불구하고:

Dim i as Long
Dim VarCount as Long
Dim Var as Variant

'generate your variant here

i = 0
VarCount = 0
recheck1:
  If IsEmpty(Var(i)) = True Then GoTo VarCalc
    i = i + 1
    GoTo recheck1
VarCalc:
  VarCount= i - 1

참고: Var(0)가 존재하지 않는 경우 VarCount는 분명히 음수를 반환합니다.VarCount는 Var(i)와 함께 사용할 수 있는 최대 참조 번호이며, i는 사용 중인 변형의 수입니다.

ubound(var) + 1을 사용하는 것은 어떻습니까? 그러면 대부분의 변수의 마지막 요소가 제공됩니다(사용자 지정 범위가 아닌 경우에는 해당 정보를 이미 알고 있어야 합니다).일반적인 변수의 범위(예: 분할 함수를 사용하는 경우)는 0으로 시작하며, unbound는 변수의 마지막 항목을 제공합니다.예를 들어 8개의 요소가 있는 변수가 있으면 0(lbound)에서 7(ubound)로 이동하고 ubound(var) + 1만 추가하면 요소의 양을 알 수 있습니다. 예:

Public Sub PrintQntElements()
    Dim str As String
    Dim var As Variant
    Dim i As Integer

    str = "Element1!Element2!Element3!Element4!Element5!Element6!Element7!Element8"
    var = Split(str, "!")
    i = UBound(var) + 1
    Debug.Print "First element: " & LBound(var)
    Debug.Print "Last element: " & UBound(var)
    Debug.Print "Quantity of elements: " & i
End Sub

그러면 다음 출력이 즉시 창에 인쇄됩니다.
첫 번째 요소: 0
마지막 요소: 7
요소의 수량: 8

또한 첫 번째 요소(lbound)가 0인지 확실하지 않으면 다음을 사용할 수 있습니다.

i = U 보운드(var) - L 보운드(var) + 1

언급URL : https://stackoverflow.com/questions/6901991/how-to-return-the-number-of-dimensions-of-a-variant-variable-passed-to-it-in-v

반응형