二次元配列で任意の二行を入れ替え

昨日は、二次元配列で任意の一行をカット&挿入することに挑戦した。
infoment.hatenablog.com

今日は、今までに作ったものの組合せで、任意の二行を入れ替えることに挑戦。
f:id:Infoment:20190904224055p:plain

今回は、昨日作成したものを二回連続で行うことで実現する。

  1. 片方を切り取って、入れ替えたいものの上に挿入する。
  2. もう片方を切り取って、1.があった場所に挿入する。

これを行う際の注意点は二つ。

  1. 指定した二行について、行番号の大小が逆転しないようにする。
  2. もう片方を切り取る際、上に一行挿入済みであるため、指定行+1で処理することに注意する。

日本語にするとややこしいこれを、コードにするとこうなる。

クラスモジュール(ArrayEditClass)
' 行の入れ替え
Public Function RowExchange(row_index_1 As Long, _
                            row_index_2 As Long) As Variant
    Dim r_low As Long
        r_low = WorksheetFunction.Min(row_index_1, row_index_2)
    Dim r_high As Long
        r_high = WorksheetFunction.Max(row_index_1, row_index_2)
    
        source_array = RowCutAndPaste(r_high, r_low, xlCut, cpInsert, xlDown)
        RowExchange = RowCutAndPaste(r_low + 1, r_high, xlCut, cpInsert, xlUp)
End Function

それでは早速、テストしてみよう。

Sub test()
    Dim SQC As SeaquenceClass
    Set SQC = New SeaquenceClass
    
    Dim arr_1() As Variant
    Dim arr_2() As Variant
    Dim i As Long
    
        For i = 1 To 8
            arr_1 = Range("A1").CurrentRegion.Value
            arr_2 = SQC.TargetArray(arr_1).RowExchange(4, i)
            
            Range("F1").Resize(UBound(arr_2), UBound(arr_2, 2)) = arr_2
            MsgBox "!"
        Next
End Sub

結果は、下記の通り。4行目(つまりNo.3の行)が、1行目から8行目までと順次入れ変わってゆく。
f:id:Infoment:20190904225059g:plain

ということで、今回も上手くいったようだ。

明日に続きます。

参考まで。