2次元配列の回転

セルのデータを左右回転、行列の入れ替え、右上を基準にした反転、180度回転、ランダムに再配置するヤツをまとめた。関数化してません。

A1に作ってある表を回転してA20に吐き出します。

90度回転シリーズ。左へ90度回転、右へ90度回転、行列の入れ替え（左上基準）、右上基準の反転。

Sub 行列回転()
    
    Dim r As Range, selectRange As Range
    Set selectRange = Range("A1").CurrentRegion
    
    Dim arr, newarr
    arr = selectRange.Value
    
    Dim LB1, LB2, UB1, UB2
    
    LB1 = LBound(arr, 1)
    UB1 = UBound(arr, 1)
    LB2 = LBound(arr, 2)
    UB2 = UBound(arr, 2)
    
    ReDim newarr(LB2 To UB2, LB1 To UB1) '次元を逆にする
    
    Dim i As Integer, k As Integer
    
    For i = LB1 To UB1
        For k = LB2 To UB2
            
            'newarr(LB2 + UB2 - k, i) = arr(i, k) '左回転
            'newarr(k, LB1 + UB1 - i) = arr(i, k) '右回転
            'newarr(k, i)             = arr(i, k) '行列入替
            newarr(LB2 + UB2 - k, LB1 + UB1 - i) = arr(i, k) '右上基準反転
            
        Next
    Next
    
    Dim newUB1, newUB2
    newUB1 = UBound(newarr, 1)
    newUB2 = UBound(newarr, 2)
    
    Range("A20").Resize(newUB1, newUB2).Value = newarr
    
End Sub

180度回転。逆から配置するだけ。

Sub 回転()
    
    Dim r As Range, selectRange As Range
    Set selectRange = Range("A1").CurrentRegion
    
    Dim arr, newarr
    arr = selectRange.Value
    
    Dim LB1, LB2, UB1, UB2
    
    LB1 = LBound(arr, 1)
    UB1 = UBound(arr, 1)
    LB2 = LBound(arr, 2)
    UB2 = UBound(arr, 2)
    
    ReDim newarr(LB1 To UB1, LB2 To UB2) '180度
    
    Dim i As Integer, k As Integer
    
    For i = LB1 To UB1
        For k = LB2 To UB2
            
            newarr(LB1 + UB1 - i, LB2 + UB2 - k) = arr(i, k) '180度
            
        Next
    Next
    
    Dim newUB1, newUB2
    newUB1 = UBound(newarr, 1)
    newUB2 = UBound(newarr, 2)
    
    Range("A20").Resize(newUB1, newUB2).Value = newarr
    
End Sub

ランダム再配置。同じ要素数の配列を作ってランダムに再配置。

Sub ランダム()
    
    Dim r As Range, selectRange As Range
    Set selectRange = Range("A1").CurrentRegion
    
    Dim arr, newarr
    arr = selectRange.Value
    
    Dim col As Collection
    Set col = New Collection
    
    For Each r In selectRange
        col.Add r.Value
    Next
    
    Dim LB1, LB2, UB1, UB2
    
    LB1 = LBound(arr, 1)
    UB1 = UBound(arr, 1)
    LB2 = LBound(arr, 2)
    UB2 = UBound(arr, 2)
    
    ReDim newarr(LB1 To UB1, LB2 To UB2) 'ランダム
    
    Dim i As Integer, k As Integer, iRnd As Integer
    
    For i = LB1 To UB1
        For k = LB2 To UB2
            
            'コレクションからランダムに取得して削除
            iRnd = getRandom(1, col.Count)
            newarr(i, k) = col(iRnd)
            col.Remove iRnd
            
        Next
    Next
    
    Dim newUB1, newUB2
    newUB1 = UBound(newarr, 1)
    newUB2 = UBound(newarr, 2)
    
    Range("A20").Resize(newUB1, newUB2).Value = newarr
    
End Sub

'ランダム値を取得
Function getRandom(i_min As Integer, i_max As Integer) As Integer
    
    Dim temp As Integer
    Dim sa As Integer '差
    
    Randomize '乱数生成ジェネレータ
    
    '引数が逆だった場合は入れ替え。
    If i_max < i_min Then
        temp = i_max
        i_max = i_min
        i_min = temp
    End If
    
    sa = i_max - i_min + 1 '差分を計算
    getRandom = Int(sa * Rnd) + i_min
    
End Function

以上。