二次元配列で任意の一行を「削除」「空白化」「空白挿入」

昨日は、二次元配列で任意の一行を削除するために、クラスモジュールを二段階で作成してみた。
infoment.hatenablog.com

でも、前々回に引き続き、やっぱり何だかスッキリしない。

そこで今日は、更なる改良に挑戦する。
f:id:Infoment:20190831130045p:plain

前回は、このようなコードになった。

arr = SQC.TargetArray.RowDelete(arr, 4)

今回色々考えてみたのだが、恐らく、最後に配列と行番号の両方を一度に渡したことが、スッキリしない理由ではないかと考えた。これだと、クラスモジュールを間に挟む必要が無いから。

そこで、このような記述を成立させるべく、改造してみた。

arr = SQC.TargetArray(arr).RowDelete(4)

一つ目のクラスモジュール（SeaquenceClass）

Option Explicit

Public Function TargetArray(SourceArray As Variant) As ArrayEditClass
    Set TargetArray = New ArrayEditClass
        TargetArray.source_array = SourceArray
End Function

二つ目のクラスモジュール（ArrayEditClass）

Option Explicit

' 二次元配列編集用。
' 以下、シートイメージに準えて、
' 一次元目を行、二次元目を列と
' 表記している。

' 編集前の配列。
Public source_array As Variant
' ループ用変数：行
Dim r As Long
' ループ用変数：列
Dim c As Long
' ループ用変数：カウントアップ用（行と列併用）
Dim i As Long
' 作業結果の仮置用
Dim TempArray As Variant
' 編集内容の選択肢
Enum ProcessIndex
    ' 削除（上詰め）
    piDelete = -1
    ' 空白
    piBlank
    ' 空白挿入
    piInsert
End Enum

' row_index 行目を削除。
Public Function RowDelete(row_index As Long) As Variant
    RowDelete = RowEdit(row_index, piDelete)
End Function

' row_index 行目に空白挿入。
Public Function RowInsert(row_index As Long) As Variant
    RowInsert = RowEdit(row_index, piInsert)
End Function

' row_index 行目を空白化。
Public Function RowBlank(row_index As Long) As Variant
    ' 一旦、指定行を削除する。
    source_array = RowDelete(row_index)
    ' 指定行に空白を挿入して、指定行の空白化に代える。
    ' ただし、最終行を削除した場合は完成形となっているため、
    ' 削除結果をそのまま返すものとする。
    If row_index > UBound(source_array) Then
        RowBlank = source_array
    Else
        RowBlank = RowInsert(row_index)
    End If
End Function

' 行編集。
Private Function RowEdit(row_index As Long, p_index As ProcessIndex) As Variant
    
    ' 編集後の配列（仮置用）
    ReDim TempArray(rMin To rMax + p_index, cMin To cMax)
        i = rMin
        For r = rMin To rMax + p_index
            
            If i = row_index Then
                ' 削除または挿入によって、ループ変数を先送り
                ' （つまり一つ飛ばし）している。
                Select Case p_index
                    Case piDelete
                        i = i - p_index
                    Case piInsert
                        r = r + p_index
                End Select
            End If
            
            For c = cMin To cMax
                TempArray(r, c) = source_array(i, c)
            Next
            i = i + 1
        Next
        RowEdit = TempArray
End Function

' 行列のループ上下限（4つ）を求める。
Private Property Get rMin() As Long
    rMin = LBound(source_array, 1)
End Property

Private Property Get rMax() As Long
    rMax = UBound(source_array, 1)
End Property

Private Property Get cMin() As Long
    cMin = LBound(source_array, 2)
End Property

Private Property Get cMax() As Long
    cMax = UBound(source_array, 2)
End Property

勢いあまって、３パターンも作ってしまった。それでは、テストしてみよう。

Sub test()

    Dim SQC As SeaquenceClass
    Set SQC = New SeaquenceClass
    
    Dim arr_1() As Variant
    Dim arr_2() As Variant
    Dim arr_3() As Variant
    Dim arr_4() As Variant
        arr_1 = Range("A1").CurrentRegion.Value
        arr_2 = SQC.TargetArray(arr_1).RowDelete(4)
        arr_3 = SQC.TargetArray(arr_1).RowInsert(4)
        arr_4 = SQC.TargetArray(arr_1).RowBlank(4)
        
        Range("F1").Resize(UBound(arr_2), UBound(arr_2, 2)) = arr_2
        Range("A12").Resize(UBound(arr_3), UBound(arr_3, 2)) = arr_3
        Range("F12").Resize(UBound(arr_4), UBound(arr_4, 2)) = arr_4
        
End Sub