Transpose関数を作ることにした

先日、Transpose関数の限界を知った。
infoment.hatenablog.com

仕方ない、自分で作るか。

今回はこちらに倣って、全てではないが、多くを日本語で書いてみた。
www.limecode.jp

Function UDF_Transpose(ByVal 元配列 As Variant) As Variant

    ' 「元配列」が配列ではない場合、空配列を返して終了する。
        If Not IsArray(元配列) Then
            UDF_Transpose = Array()
            Exit Function
        End If

    ' 次元数取得用。
    Dim 仮受け As Long
    ' 元配列の次元数。
    Dim 次元数 As Long
    Dim i As Long: i = 1
        ' 一次元から順に添え字（インデックス）の最大値を取得。
        ' 存在しない次元の最大値を要求してエラーになることを
        ' 利用しているため、いったんエラーを無視している。
        On Error Resume Next
        Do
            ' 添え字の最大値取得。
            仮受け = UBound(元配列, i)
            i = i + 1
        Loop While Err.Number = 0 ' ← エラーが発生しない限り繰り返す。
        
        ' エラー無視設定を解除。
        On Error GoTo 0
        ' 正常ループ時に1、異常発生時に1を加えているため、i-2 が次元数となる。
        次元数 = i - 2

    ' 行列を入れ替えた情報を仮置きする配列。
    Dim 仮配列() As Variant
    Dim 行番号 As Long
    Dim 列番号 As Long
        
        Select Case 次元数
            
            ' 要素数がｎ個の一次元配列は、ｎ行１列の二次元配列に変換する。
            Case 1
                ReDim 仮配列(1 To UBound(元配列, 1) - LBound(元配列, 1) + 1, 1 To 1)
                For 行番号 = 1 To UBound(仮配列, 1)
                    仮配列(行番号, 1) = 元配列(行番号 + LBound(元配列, 1) - 1)
                Next
            
            ' 二次元配列の場合。
            Case 2
                ' ｎ行１列の配列に限り、要素数ｎ個の一次元配列に変換する。
                ' ※本家本元のTranspose関数に倣う。
                If UBound(元配列, 2) = 1 Then
                    ReDim 仮配列(1 To UBound(元配列, 1))
                    For 行番号 = 1 To UBound(仮配列, 1)
                        仮配列(行番号) = 元配列(行番号 + LBound(元配列, 1) - 1, 1)
                    Next
                Else
                    ReDim 仮配列(1 To UBound(元配列, 2) - LBound(元配列, 2) + 1, _
                                 1 To UBound(元配列, 1) - LBound(元配列, 1) + 1)
                    For 行番号 = 1 To UBound(仮配列, 1)
                        For 列番号 = 1 To UBound(仮配列, 2)
                            仮配列(行番号, 列番号) = 元配列(列番号 + LBound(元配列, 2) - 1, _
                                                            行番号 + LBound(元配列, 1) - 1)
                        Next
                    Next
                End If
            
            ' 三次元以上の場合、空配列を返す。
            Case Else
                UDF_Transpose = Array()
        
        End Select
        
        UDF_Transpose = 仮配列
End Function

前回の限界がこちら。

それでは、限界を突破できるか試してみよう。

Sub Test()
    Dim arr(1, 1) As Variant
    Dim i As Long
    Dim temp As Variant
    
        On Error Resume Next
        Do
            i = i + 1
            arr(0, 0) = WorksheetFunction.Rept("あ", i)
            temp = UDF_Transpose(arr)
            If i = 40000 Then
                MsgBox "40000突破!"
                Exit Sub
            End If
        Loop While Err.Number = 0
        
        MsgBox i - 1 & " 個が限界です"
End Sub

今後は、こちらで対応するとしよう。

参考まで。