二次元配列で任意の一行を「コピー or カット」して「挿入 or 貼り付け」

昨日は二次元配列で、任意の一行に以下を行うクラスモジュールを作成した。

  1. 削除
  2. 空白化
  3. 空白挿入

infoment.hatenablog.com

本日は更に、以下を加えることに挑戦する。

  1. コピーまたはカット
  2. 挿入または貼り付け

f:id:Infoment:20190901102814p:plain

クラスモジュール(ArrayEditClass)

まず、モードの切り替えが二つ必要だ。コピーとカットについては、既存のものを使わせてもらうとしよう。
f:id:Infoment:20190901103048p:plain

挿入するか、または上書きで貼り付けるかのEnumは存在しない(?)ようだ。仕方が無いので、自前で拵えるとしよう。

' カット&ペーストの貼り付け選択肢
Enum CutAndPasteResult
    cpInsert
    cpOverWrite
End Enum

抜き出す一行は、関数化しておく。

' カット&ペースト用配列。
Private Function source_row_array(source_row_index) As Variant
    ReDim TempArray(1 To 1, cMin To cMax)
        For c = cMin To cMax
            TempArray(1, c) = source_array(source_row_index, c)
        Next
    source_row_array = TempArray
End Function

最後に、本体を作成。

' カット&ペースト
Public Function RowCutAndPaste(source_row_index As Long, _
                               destination_row_index As Long, _
                      Optional cut_or_copy As Excel.XlCutCopyMode = xlCut, _
                      Optional overwrite_or_insert As CutAndPasteResult = cpOverWrite) As Variant
                       
    Dim arr As Variant
        arr = source_row_array(source_row_index)
                       
    ' 貼り付け または 挿入先を準備。
    ' 貼り付けの場合は処置不要。
        If overwrite_or_insert = cpInsert Then
            source_array = RowInsert(destination_row_index)
        End If
    
    ' 貼り付け または 挿入。
        For c = cMin To cMax
            source_array(destination_row_index, c) = arr(1, c)
        Next
    
    ' カット または コピー
    ' コピーの場合は処置不要。
        If cut_or_copy = xlCut Then
        ' 挿入行がカット行以前にある場合、カット行を+1。
            If overwrite_or_insert = cpInsert Then
                If source_row_index >= destination_row_index Then
                    source_row_index = source_row_index + 1
                End If
            End If
            RowCutAndPaste = RowDelete(source_row_index)
        Else
            RowCutAndPaste = source_array
        End If

End Function

ここからは、恒例のテストとなる。昨日と似たような感じだ。
↓ 元となるデータがこちら。
f:id:Infoment:20190901103525p:plain

コードがこちら。

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
    Dim arr_5() As Variant
        arr_1 = Range("A1").CurrentRegion.Value
        arr_2 = SQC.TargetArray(arr_1).RowCutAndPaste(4, 2, xlCut, cpInsert)
        arr_3 = SQC.TargetArray(arr_1).RowCutAndPaste(4, 2, xlCut, cpOverWrite)
        arr_4 = SQC.TargetArray(arr_1).RowCutAndPaste(4, 2, xlCopy, cpInsert)
        arr_5 = SQC.TargetArray(arr_1).RowCutAndPaste(4, 2, xlCopy, cpOverWrite)
        
        Range("A12").Resize(UBound(arr_2), UBound(arr_2, 2)) = arr_2
        Range("F12").Resize(UBound(arr_3), UBound(arr_3, 2)) = arr_3
        Range("A22").Resize(UBound(arr_4), UBound(arr_4, 2)) = arr_4
        Range("F22").Resize(UBound(arr_5), UBound(arr_5, 2)) = arr_5
        
End Sub

f:id:Infoment:20190901104433p:plain

結果、以下の場合に不備があることが分かった。

  1. コピーまたはカットして、最後尾に挿入する場合。
  2. カットして、同じ行に貼り付けた場合。

明日は上記の修正 + α に挑戦します。

参考まで。