VBA100本ノック98-99・席替えルールが守られているか確認・実行

VBA100本ノック 98本目：席替えルールが守られているか確認
https://excel-ubara.com/vba100/VBA100_098.html
VBA100本ノック 99本目：自動席替え（行列と前後左右が全て違うように）
https://excel-ubara.com/vba100/VBA100_099.html

この動画のマクロはWindows11/Office2013で作成してます。

Sub 席替え実行()
    
    '0始まりなので実際の行,ee列数-1を設定
    Const 最大行 = 5    '縦　y軸方向
    Const 最大列 = 5    '横　x軸方向
    
    
    Set 現座席左上 = ThisWorkbook.Sheets("座席表（現）").Range("b5")
    Set 新座席左上 = ThisWorkbook.Sheets("座席表（現）").Range("b13")
    Set WK座席左上 = ThisWorkbook.Sheets("座席表（現）").Range("b22")
    
    Range(新座席左上, 新座席左上.Offset(最大行, 最大列)).ClearContents
    Range(WK座席左上, WK座席左上.Offset(最大行, 最大列)).ClearContents
    
    'f(n) = (2n+1) mod (5+2)
    '{0,1,2,3,4,5} -> {1,3,5,0,2,4}　←前後の数字は少なくとも2以上離れる
    '最大行（列）数が奇数のときのみうまくいく
  
    '行について関数fで移動
    For i = 0 To 最大行
        Range(現座席左上.Offset(i, 0), 現座席左上.Offset(i, 最大列)).Copy Destination:=WK座席左上.Offset((2 * i + 1) Mod (最大行 + 2), 0)
    Next
    
    '列について関数fで移動
    For i = 0 To 最大列
        Range(WK座席左上.Offset(0, i), WK座席左上.Offset(最大行, i)).Copy Destination:=新座席左上.Offset(0, (2 * i + 1) Mod (最大列 + 2))
    Next
    
    Range(WK座席左上, WK座席左上.Offset(最大行, 最大列)).Clear
    
    Call 席替えチェック
    
End Sub


Sub 席替えチェック()
    Dim f(5, 5)
    
    Set 現座席左上 = ThisWorkbook.Sheets("座席表（現）").Range("b5")
    Set 新座席左上 = ThisWorkbook.Sheets("座席表（現）").Range("b13")
   
    For y = 0 To 5
        For x = 0 To 5
        '新しい席を見つける
        Set c = Range(新座席左上, 新座席左上.Offset(5, 5)).Find(現座席左上.Offset(y, x).Value)
        '新しい席番を 席番配列にいれる
        f(y, x) = Array(c.Row - 新座席左上.Row, c.Column - 新座席左上.Column)
        Next
    Next

    '座席チェックを行う
    For y = 0 To 5
        For x = 0 To 5
            '前と同じ行列か？
            If (y = f(y, x)(0)) Or (x = f(y, x)(1)) = True Then
                Debug.Print "行列が同じ:" & 現座席左上.Offset(y, x).Value
                新座席左上.Offset(f(y, x)(0), f(y, x)(1)).Interior.ColorIndex = 6
            End If

            '下の人の移転先をチェック
            If y <> 5 Then
                '三平方の定理でf(y, x)とf(y+1, x)との距離を調べる
                If (f(y, x)(0) - f(y + 1, x)(0)) ^ 2 + (f(y, x)(1) - f(y + 1, x)(1)) ^ 2 = 1 Then
                    Debug.Print "下が隣:" & 現座席左上.Offset(y, x).Value
                    新座席左上.Offset(f(y, x)(0), f(y, x)(1)).Interior.ColorIndex = 6
                End If
            End If
            '上の人の移転先をチェック
            If y <> 0 Then
                '三平方の定理でf(y, x)とf(y-1, x)との距離を調べる
                If (f(y, x)(0) - f(y - 1, x)(0)) ^ 2 + (f(y, x)(1) - f(y - 1, x)(1)) ^ 2 = 1 Then
                    Debug.Print "上が隣:" & 現座席左上.Offset(y, x).Value
                    新座席左上.Offset(f(y, x)(0), f(y, x)(1)).Interior.ColorIndex = 7
                End If
            End If
            '右の人の移転先をチェック
            If x <> 0 Then
                '三平方の定理でf(y, x)とf(y, x-1)との距離を調べる
                If (f(y, x)(0) - f(y, x - 1)(0)) ^ 2 + (f(y, x)(1) - f(y, x - 1)(1)) ^ 2 = 1 Then
                    Debug.Print "右が隣:" & 現座席左上.Offset(y, x).Value
                    新座席左上.Offset(f(y, x)(0), f(y, x)(1)).Interior.ColorIndex = 8
                End If
            End If
            '左の人の移転先をチェック
            If x <> 5 Then
                '三平方の定理でf(y, x)とf(y, x+1)との距離を調べる
                If (f(y, x)(0) - f(y, x + 1)(0)) ^ 2 + (f(y, x)(1) - f(y, x + 1)(1)) ^ 2 = 1 Then
                    Debug.Print "左が隣:" & 現座席左上.Offset(y, x).Value
                    新座席左上.Offset(f(y, x)(0), f(y, x)(1)).Interior.ColorIndex = 6
                End If
            End If
        Next
    Next
End Sub