二次元配列で任意の一行を「コピー or カット」して「挿入 or 貼り付け」
昨日は二次元配列で、任意の一行に以下を行うクラスモジュールを作成した。
- 削除
- 空白化
- 空白挿入
本日は更に、以下を加えることに挑戦する。
- コピーまたはカット
- 挿入または貼り付け
クラスモジュール(ArrayEditClass)
まず、モードの切り替えが二つ必要だ。コピーとカットについては、既存のものを使わせてもらうとしよう。
挿入するか、または上書きで貼り付けるかの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
ここからは、恒例のテストとなる。昨日と似たような感じだ。
↓ 元となるデータがこちら。
コードがこちら。
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
結果、以下の場合に不備があることが分かった。
- コピーまたはカットして、最後尾に挿入する場合。
- カットして、同じ行に貼り付けた場合。
明日は上記の修正 + α に挑戦します。
参考まで。