VBA100本ノック 34本目:配列の左右回転

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。

これは面白い問題。今回は、このように考えた。

  1. 左右の向きに関わらず、3回回すと元に戻る。
  2. 左に3回は、右に1回と同じ。

ということで、まず右に(時計回りに)1回回すのがこちら。

' 配列を右に回転させる関数。
Function RotationToRight(ByVal source_array As Variant) As Variant
    ' 回転後の配列を格納するための配列。
    ' 配列を1始まりに矯正している。
    Dim arr() As Variant
    ReDim arr(1 To UBound(source_array, 2) - LBound(source_array, 2) + 1, _
              1 To UBound(source_array, 1) - LBound(source_array, 1) + 1)
    Dim i As Long
    Dim j As Long
    
    ' 回転。
        For i = 1 To UBound(arr)
            For j = 1 To UBound(arr, 2)
                arr(i, j) = source_array(j + LBound(source_array) - 1, _
                                         UBound(source_array, 2) + 1 - i)
            Next
        Next
        
        RotationToRight = arr
End Function

次いで、「左右のどちらか」「回転する回数」を指定して回転する関数がこちら。

Function RotateArray(source_array As Variant, _
            Optional rotation_direction As XlDirection = xlToRight, _
            Optional rotation_times As Long = 1) As Variant
    ' 右に一回転を初期設定とする。
    ' 4回転で1周するので、まず4回以上の指定回数を1~4に変換する。
    Dim RotationTimes As Long
        RotationTimes = rotation_times - 1 Mod 4 + 1
    
    ' 右以外が指定された場合は左回転と見做し、右回転に換算する。
    ' 例えば左へ3回転は、右へ1回転と同じ。
        If rotation_direction <> xlToRight Then
            RotationTimes = 4 - RotationTimes
        End If
    
    Dim arr() As Variant
    ReDim arr(1 To UBound(source_array, 1) - LBound(source_array, 1) + 1, _
              1 To UBound(source_array, 2) - LBound(source_array, 2) + 1)
    Dim i As Long
    Dim j As Long
    
        For i = 1 To UBound(arr)
            For j = 1 To UBound(arr, 2)
                arr(i, j) = source_array(i - 1 + LBound(source_array, 1), _
                                         j - 1 + LBound(source_array, 2))
        Next j, i
        
        Select Case RotationTimes
            Case 1 To 3
                For i = 1 To RotationTimes
                    arr = RotationToRight(arr)
                Next
        End Select
        
        RotateArray = arr
End Function

それでは、↓ こちらで検証してみよう。

Sub VBA_100Knock_034()
    Dim arr As Variant
        arr = Range("A1:D3")
        
        ' 右に90度。
        Range("A6:C9") = RotateArray(arr)

        ' 左に90度。
        Range("A12:C15") = RotateArray(arr, xlToLeft)
End Sub

↓ 結果がこちら。

※冒頭リンク先の解答例および解説も、ぜひご一読ください。

参考まで。