VBA 배열(Array) 관련 유용한 함수

VBA에서 배열(Array)을 이용할 때 유용한 함수로 자주 사용하는 것들을 모아 놓은 것입니다.

2023-05-22 TransposeArray 수정하고, SliceArray 추가

 

□ IsArray() : 배열인지 아닌지 확인하는 함수

- 변수를 Variant로 선언하고 VarArray = UsedRange.Value2 처럼 Range를 직접 배열에 할당하는 경우

  배열이 초기 상태는 Empty라서 IsArray 결과 값은 False이고, 할당된 이후에는 True가 되어 

  할당 여부를 확인할 때 사용

 

□ getDimension() : 배열이 1차원인지, 2차원인지 확인하는 함수

결과값 : 배열이 아니면 0, 1차원 배열은 1, 2차원 배열은 2,,,,

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

728x90

 

□ ArrayExists() : 배열에 찾은 내용이 있는지 확인하는 함수

결과값 : 찾는 값이 배열에 있으면 True, 없으면 False

문자열인 경우 마지막 인수를 False로 지정하면 대소문자를 구분하여 검색함

배열에는 Dictionary처럼 (oDict.Exists) 어떤 요소가 있는지 확인하는 기능이 없어서 같은 기능을 원할 때 사용

Function ArrayExists(argArray As Variant, toBeFound As Variant, _
                    Optional IgnoreCase As Boolean = True) As Boolean
    Dim vItem As Variant
    
    '// 찾는 값이 문자열일 경우에만 대소문자 무시여부에 따라 처리 
    If TypeName(toBeFound) = "String" And IgnoreCase Then toBeFound = UCase(toBeFound)
    
    For Each vItem In argArray
    	'//배열 요소도 문자열인 경우에만 대소문자 무시여부에 따라 처리
        If TypeName(vItem) = "String" And IgnoreCase Then vItem = UCase(vItem)
        '// 배열 요소중 찾는 값이 확인되면 중단
        If vItem = toBeFound Then
            ArrayExists = True
            Exit Function
        End If
    Next
    
End Function

 

□ SizeOf() : 배열의 크기(요소의 수)를 확인

결과값 : 배열이 아닌 경우 0, 1차원 배열은 배열의 수, 2차원 배열은 1차원 요소 * 2차원 요소

배열에 값이 있는지 없는지는 상관없음

Function SizeOf(argArray As Variant)
    Dim tArray As Variant, iRow As Long, iCol As Long
    '//인수가 오류이면 오류 그대로
    If IsError(argArray) Then SizeOf = argArray: Exit Function
    
    '// 인수가 영역이면 영역의 값을 배열로 처리
    If TypeName(argArray) = "Range" Then tArray = argArray.Value2 Else tArray = argArray
    
    '// Variant로 할당이 안된 경우
    If IsEmpty(tArray) Then SizeOf = 0: Exit Function
    
    '// 배열이 아닌 일반 변수
    If Not isArray(tArray) Then SizeOf = 1: Exit Function
    
    '// 배열인 경우 우선 1차원 배열의 요소 확인
    iRow = UBound(tArray) - LBound(tArray) + 1
    
    '// 2차원 배열을 점검하나 오류(1차원 배열)일 경우 1로 대체
    On Error Resume Next
    iCol = UBound(tArray, 2) - LBound(tArray, 2) + 1
    On Error GoTo 0
    If iCol = 0 Then iCol = 1
    
    '// 1차원 요소와 2차원 요소의 수를 곱함
    SizeOf = iRow * iCol
    
End Function

 

□ TransposeArray() : 가로/세로를 뒤집은 2차원 배열을 만듦

배열이 아닌 경우에나 오류인 경우에는 그대로 반환

1차원 배열인 경우 열이 하나인 2차원 배열로 변환되어 반환

2차원 배열인 경우 열과 행이 뒤집힌 배열로 반환

 

Excel 함수인 Transpose를 사용할 경우 1차원(가로행 1줄)은 2차원(세로열 1줄)으로 잘 변환 되나

2차원이면서 열이 1개뿐인 배열(세로열 1줄)은 1차원 배열로 변환되는 문제가 있어 사용하는 것임

Public Function TransposeArray(argArray As Variant) As Variant
''  배열에 대해서 행/열을 뒤집음, 배열이 아닌 경우 그대로 반환
''  1차원 배열인 경우 열이 1개인 2차원 배열로 변환
''  2차원 배열인 경우 행/열을 바꾼 배열로 변환
    Dim d As Long, R As Long, C As Long
    Dim lbc As Long, ubc As Long, lbr As Long, ubr As Long
    Dim rArray As Variant
    
    d = getDimension(argArray)
    
    If d = 0 Then       '' 배열이 아닌 경우
        TransposeArray = argArray
        Exit Function
    ElseIf d = 1 Then   '' 1차원 배열인 경우
        lbr = LBound(argArray):         ubr = LBound(argArray)
        lbc = LBound(argArray):         ubc = UBound(argArray)
    ElseIf d = 2 Then   '' 2차원 배열인 경우
        lbr = LBound(argArray, 1):      ubr = UBound(argArray, 1)
        lbc = LBound(argArray, 2):      ubc = UBound(argArray, 2)
    Else
        TransposeArray = CVErr(xlErrRef)
        Exit Function
    End If
    
    ReDim rArray(lbc To ubc, lbr To ubr)
    
    For R = lbr To ubr
        For C = lbc To ubc
            If d = 1 Then
                rArray(C, R) = argArray(C)
            Else
                rArray(C, R) = argArray(R, C)
            End If
        Next C
    Next R
    
    TransposeArray = rArray
    
End Function

 

□ ReverseArray() : 2차원 배열에 대해서 행을 뒤집은 배열을 만듦

Public Function ReverseArray(argArray As Variant)
    Dim r As Long, c As Long
    Dim lbr As Long: lbr = LBound(argArray, 1)
    Dim ubr As Long: ubr = UBound(argArray, 1)
    Dim lbc As Long: lbc = LBound(argArray, 2)
    Dim ubc As Long: ubc = UBound(argArray, 2)
    Dim rArray As Variant
    
    
    ReDim rArray(lbr To ubr, lbc To ubc)
    For r = lbr To ubr: For c = lbc To ubc
        rArray(r, c) = argArray(ubr - r + lbr, c)
    Next:               Next

    ReverseArray = rArray

End Function

 

□ SliceArray() : Range나 2차원 배열에 대해서 지정하는 행/열을 추출

행이나 열번호를 지정하여 1차원 또는 2차원 배열로 추출함

특정 행/열을 다른 용도로 사용하기 위하여 추출할 때 사용

Function SliceArray(argArray As Variant, Optional RowCol As String = "C", Optional RowColNumber As Long = 1, Optional Dimension As Integer = 1)
    ''  행이나, 열을 지정하여 배열로 추출
    ''  RowCol  행지정에 "R", "Row", 열지정에 "C", "Col", "Column" 사용
    ''  RowColNumver에 추출할 행/열번호로 1부터 시작
    ''  Dimenison 추출한 결과 배열의 차원을 지정, 1 또는 2
    Dim oArray As Variant, rArray As Variant
    Dim R As Long, C As Long
    
    If UCase(RowCol) = "R" Or UCase(RowCol) = "ROW" Then
        R = RowColNumber: C = 0
    ElseIf UCase(RowCol) = "C" Or UCase(RowCol) = "COL" Or UCase(RowCol) = "COLUMN" Then
        R = 0: C = RowColNumber
    Else
        SliceArray = CVErr(xlErrValue): Exit Function
    End If
    
    If TypeName(argArray) = "Range" Then
        If argArray Is Nothing Then SliceArray = CVErr(xlErrValue): Exit Function
        oArray = Intersect(argArray, argArray.Parent.UsedRange).Value2
    Else
        If Not IsArray(argArray) Then SliceArray = CVErr(xlErrRef): Exit Function
        oArray = argArray
    End If
    
    rArray = Application.Index(oArray, R, C)
    If Dimension = 1 Then
        If C > 0 Then rArray = Application.Transpose(rArray)
    ElseIf Dimension = 2 Then
        If R > 0 Then
            rArray = Application.Transpose(rArray)
            rArray = TransposeArray(rArray)
        End If
    Else
        SliceArray = CVErr(xlErrValue): Exit Function
    End If
    
    SliceArray = rArray
    
End Function

 

□ QuickSort() : 2차원 배열을 지정한 Colum에 대해서 정렬한 배열을 만듦

Excel sheet의 셀과 같은 방식으로 지정하는 열을 기준으로 오름차순이나 내림차순으로 정렬

 

Public Sub QuickSort(ByRef argArray As Variant, Optional ByVal argColumn As Long = 0, Optional ByVal iAsc As Long = 1, Optional ByVal rMin As Long = -1, Optional ByVal rMax As Long = -1)
'   출처:https://stackoverflow.com/a/5104206

'   Sort a 2-Dimensional array
'   SampleUsage: sort arrData by the contents of column 3
'
'      QuickSortArray arrData,3,
'
'   Posted by Jim Rech 10/20/98 Excel.Programming
'   Modifications, Nigel Heffernan:
'       ' Escape failed comparison with empty variant
'       ' Defensive coding: check inputs
'   Modifications, EG Tools:
'       ' 인수와 변수의 이름을 Excel 사용 및 알고리듬 설명에 맞게 수정함
'       ' Excel에서 사용상 편리를 위해서 lngColumn위치를 2번째로 변경함
'       ' 오름차순/내림차순을 선택할 수 있도록 iAsc 인수를 추가함
'       ' 1D Array는 Application.Transpose(SortArray)를 통해서 2D로 바꾸어 진행한 후 다시 Transpose할 것
'       ' ## 부분의 설명은 오름차순 기준으로 설명함.

    On Error Resume Next

    Dim iLow As Long
    Dim iHigh As Long
    Dim vPivot As Variant
    Dim arrTemp As Variant
    Dim iCol As Long

    '// Pivot, Left, Right를 Excel 개념에 맞게 행 번호가 작은 것을 Low, 행번호가 큰 것을 High로 지칭함.
    '// 인수들을 확인
    If IsEmpty(argArray) Then Exit Sub
    If InStr(TypeName(argArray), "()") < 1 Then Exit Sub   'IsArray() is somewhat broken: Look for brackets in the type name
    If rMin = -1 Then rMin = LBound(argArray, 1)
    If rMax = -1 Then rMax = UBound(argArray, 1)
    If rMin >= rMax Then Exit Sub

    '// 시작점과 종료점을 확인
    iLow = rMin: iHigh = rMax

    '// Pivot값을 중앙값으로 설정
    vPivot = Empty
    vPivot = argArray((rMin + rMax) \ 2, argColumn)

    '// Pivot값을 확인하고 쓸데 없는 것이면 목록 끝으로 보낸다...?
    '// 그냥 Exit Sub를 하지 않고, 왜 iLow=rMax, iHigh=rMin을 하는지?
    '// While iLow <= iHigh 조건에 따라 실행되는 코드가 없는데 말이지...
    ' We  send 'Empty' and invalid data items to the end of the list:
    If IsObject(vPivot) Then  ' note that we don't check isObject(argArray(n)) - vPivot *might* pick up a valid default member or property
        iLow = rMax
        iHigh = rMin
    ElseIf IsEmpty(vPivot) Then
        iLow = rMax
        iHigh = rMin
    ElseIf IsNull(vPivot) Then
        iLow = rMax
        iHigh = rMin
    ElseIf vPivot = "" Then
        iLow = rMax
        iHigh = rMin
    ElseIf VarType(vPivot) = vbError Then
        iLow = rMax
        iHigh = rMin
    ElseIf VarType(vPivot) > 17 Then
        iLow = rMax
        iHigh = rMin
    End If

    '// 낮은가이드와 높은가이드가 교차될 때까지 진행
    While iLow <= iHigh
        '## 낮은가이드 값이 Pivot보다 작고 종료점이 아니면 높은 쪽으로 이동
        '## 즉 Pivot보다 크거나 같은 것을 찾음
        If iAsc > 0 Then
            While argArray(iLow, argColumn) < vPivot And iLow < rMax: iLow = iLow + 1: Wend
        Else
            While argArray(iLow, argColumn) > vPivot And iLow < rMax: iLow = iLow + 1: Wend
        End If
        '## 높은가이드 값이 Pivot보다 크고 시작점이 아니면 낮은 쪽으로 이동
        '## 즉, Pivot보다 작거나 같은 것을 찾음
        If iAsc > 0 Then
            While vPivot < argArray(iHigh, argColumn) And iHigh > rMin: iHigh = iHigh - 1: Wend
        Else
            While vPivot > argArray(iHigh, argColumn) And iHigh > rMin: iHigh = iHigh - 1: Wend
        End If
        '// 아직 낮은가이드와 높은가이드가 교차되지 않았으면, 임시변수를 이용해서
        '// 찾은 Pivot보다 큰 낮은가이드 값과 Pivot보다 작은 높은가이드 값을 바꿔치지
        If iLow <= iHigh Then
            ReDim arrTemp(LBound(argArray, 2) To UBound(argArray, 2))
            For iCol = LBound(argArray, 2) To UBound(argArray, 2)
                arrTemp(iCol) = argArray(iLow, iCol)
                argArray(iLow, iCol) = argArray(iHigh, iCol)
                argArray(iHigh, iCol) = arrTemp(iCol)
            Next iCol
            Erase arrTemp
            
            '// 바꿔치기한 후에 다시 한 칸씩 이동
            iLow = iLow + 1
            iHigh = iHigh - 1
        End If
    Wend

    '// 높은가이드가 시작점에 도달하지 않았으면 시작부터 높은 가이드까지 다시 재귀호출
    If (rMin < iHigh) Then Call QuickSort(argArray, argColumn, iAsc, rMin, iHigh)
    '// 낮은가이드가 종료점에 도달하지 않았으면 낮은 가이드부터 종료점까지 다시 재귀호출
    If (iLow < rMax) Then Call QuickSort(argArray, argColumn, iAsc, iLow, rMax)
    
End Sub