Index関数も作ることにした

昨日は、Transpose関数を作ってみた。
infoment.hatenablog.com

ついでに、Index関数も作ってみた。

Transpose関数と同様のテストを行い、Index関数で配列をスライスする際の限界に挑戦してみた。

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 = WorksheetFunction.index(arr, 1, 0)
        Loop While Err.Number = 0
        
        MsgBox i - 1 & " 個が限界です"
End Sub

すると、Transpose関数と全く同じ結果になった。

ならば、これも自分で作るしかあるまい。
今回は、Transpose関数より仕様が複雑なので、その分だけ大掛かりになった。
※今回も、多くを日本語で書いてみた。

Function UDF_Index(ByVal 元配列 As Variant, 行番号 As Long, Optional 列番号 As Long = 1) As Variant

    ' 「元配列」が配列ではない場合、空配列を返して終了する。
        If Not IsArray(元配列) Then
            UDF_Index = 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
    
        Select Case 次元数
            
            ' 以下、本家本元のIndex関数に倣う。
            ' 一次元配列の場合。
            Case 1
                ReDim 仮配列(1 To UBound(元配列, 1) - LBound(元配列, 1) + 1)
                For i = 1 To UBound(仮配列, 1)
                    仮配列(i) = 元配列(i + LBound(元配列, 1) - 1)
                Next
                
                If 列番号 = 0 Then
                    UDF_Index = 仮配列
                
                ElseIf 行番号 = 0 Then
                    UDF_Index = Array(仮配列(列番号))
                
                Else
                    UDF_Index = 仮配列(行番号)
                
                End If
            
            ' 二次元配列の場合。
            Case 2
                If 行番号 = 0 And 列番号 = 0 Then
                    ReDim 仮配列(1 To UBound(元配列, 1) - LBound(元配列, 1) + 1, _
                                 1 To UBound(元配列, 2) - LBound(元配列, 2) + 1)
                    For 行番号 = 1 To UBound(仮配列, 1)
                        For 列番号 = 1 To UBound(仮配列, 2)
                            仮配列(行番号, 列番号) = 元配列(行番号 + LBound(元配列, 1) - 1, _
                                                            列番号 + LBound(元配列, 2) - 1)
                        Next
                    Next
                    UDF_Index = 仮配列
                
                ElseIf 列番号 = 0 Then
                    ReDim 仮配列(1 To UBound(元配列, 2) - LBound(元配列, 2) + 1)
                    For 列番号 = 1 To UBound(仮配列, 1)
                        仮配列(列番号) = 元配列(行番号 + LBound(元配列, 1) - 1, _
                                                列番号 + LBound(元配列, 2) - 1)
                    Next
                    UDF_Index = 仮配列
                
                ElseIf 行番号 = 0 Then
                    ReDim 仮配列(1 To UBound(元配列, 1) - LBound(元配列, 1) + 1, 1 To 1)
                    For 行番号 = 1 To UBound(仮配列, 1)
                        仮配列(行番号, 1) = 元配列(行番号 + LBound(元配列, 1) - 1, _
                                                   列番号 + LBound(元配列, 2) - 1)
                    Next
                    UDF_Index = 仮配列
                
                Else
                    UDF_Index = 元配列(行番号 + LBound(元配列, 1) - 1, _
                                       列番号 + LBound(元配列, 2) - 1)

                End If
                            
            ' 三次元以上の場合、空配列を返す。
            Case Else
                UDF_Index = Array()
        
        End Select
End Function

　
　
それでは早速、昨日と同様のテストをしてみよう。

Sub Test2()
    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_Index(arr, 1, 0)
            If i = 40000 Then
                MsgBox "40000突破!"
                Exit Sub
            End If
        Loop While Err.Number = 0
        
        MsgBox i - 1 & " 個が限界です"
End Sub

　
　
今回も、一応合格か。

昨日と同様、処理時間に体感できるほどの差は無かった。
（厳密に測定すれば、別かもしれないが）。

今後はしばらく、こちらを使うことにしよう。

参考まで。