''''''シガーボックスの色変えシミュレータ（エクセルマクロ）by森下''''''

''マクロが使える状態になったらまずA1セルをダブルクリックしてください

Option Explicit '変数を宣言して使用

''変えてもいい定数ここから
Const Max_Boxes As Long = 10 '箱数制限値
Const Max_Color As Long = 10 '色数制限値
Const Max_Trial As Long = 50 '回数制限値
Const Wait_Flag As Boolean = True '次シガーボックス生成のwaitあり・なし
Const Achieve_Flag As Boolean = True '終了メッセージあり・なし
''ここまで

Const iRow As Long = 10 '生成シガーボックス原点(Initial_Row)
Const iColumn As Long = 3

Sub Worksheet_Change(ByVal Target As Range)
'' 複数セルの場合処理なし
If Target.Count > 1 Then Exit Sub
'' 以下範囲の場合処理なし
If Target.Row >= 9 Then Exit Sub
If Target.Row <= 2 Then Exit Sub
If Target.Row = 4 Then Exit Sub
If Target.Row = 5 Then Exit Sub
If Target.Row = 7 Then Exit Sub
If Target.Column = 2 Then Exit Sub

If IsNumeric(Cells(3, 3).Value) = False Then 'シガーボックス数が不正の場合処理なし
    Call Total_Boxes_Maintain
    Exit Sub
ElseIf Cells(3, 3).Value < 1 Then
    Call Total_Boxes_Maintain
    Exit Sub
End If
Dim Total_Boxes As Long
Total_Boxes = Cells(3, 3).Value
If Target.Column >= Total_Boxes + 3 Then Exit Sub
'' 以上処理なし

If Target.Column >= 3 And Target.Column <= Total_Boxes + 2 Then
    If Target.Row = 6 Or Target.Row = 8 Then
        Call Set_Color(Target.Row, Target.Column)
    End If
End If

If Target.Row = 3 Then
    Select Case Target.Column
    Case 3
        Call Set_N_Boxes
    Case 4
        Call Set_N_Colors
    End Select
End If

If Target.Row = 8 And Target.Column = 1 Then
    Call Set_Total_Trial
End If
End Sub

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

'' 複数セルの場合処理なし
If Target.Count > 1 Then Exit Sub

'' 以下範囲の場合処理なし
If Target.Row >= 9 Then Exit Sub
If Target.Row = 4 Then Exit Sub
If Target.Row = 5 Then Exit Sub
If Target.Row = 7 Then Exit Sub
If Target.Column = 2 Then Exit Sub

Dim Total_Boxes As Long
Total_Boxes = Cells(3, 3).Value
If Target.Column >= Total_Boxes + 3 Then Exit Sub
'' 以上処理なし

If Target.Column = 1 Then
    Select Case Target.Row
    Case 2
        Call Execute_main_process
    Case 3
        Call Delete_boxes
    Case 6
        Call Change_endurance_type
    Case 1
        Call Initialize_sheet
    End Select
End If

If Target.Column >= 3 And Target.Column <= Total_Boxes + 2 Then
    If Target.Row = 6 Or Target.Row = 8 Then
        Call Change_Color(Target.Row, Target.Column)
    End If
End If

Cancel = True 'デフォルトのイベントの実行をキャンセル
End Sub

''ここまでセル操作イベント指定、ここから各イベントの中身

Sub Set_Color(ByVal tRow As Long, ByVal tColumn As Long) 'シガーボックス色セット
Application.EnableEvents = False

Dim Set_color_Num As Long
If IsNumeric(Cells(tRow, tColumn).Value) = False Then
    MsgBox "色指定数エラー"
    Set_color_Num = 0
ElseIf Cells(tRow, tColumn).Value < 0 Or Cells(tRow, tColumn).Value >= Cells(3, 4).Value Then
    MsgBox "色指定数エラー"
    Set_color_Num = 0
Else
    Set_color_Num = Cells(tRow, tColumn).Value
End If
Cells(tRow, tColumn).Value = Set_color_Num

Cells(tRow - 1, tColumn).Interior.Color = Cells(3, 5 + Set_color_Num).Interior.Color

Application.EnableEvents = True
End Sub

'’シガーボックスの色指定はダブルクリックでもいじれます（裏技）
Sub Change_Color(ByVal tRow As Long, ByVal tColumn As Long)
Application.EnableEvents = False

Dim Total_Color As Long
Total_Color = Cells(3, 4).Value
Cells(tRow, tColumn).Value = (Cells(tRow, tColumn).Value + 1) Mod Total_Color
Dim Set_color_Num As Long
Set_color_Num = Cells(tRow, tColumn).Value
Cells(tRow - 1, tColumn).Interior.Color = Cells(3, 5 + Set_color_Num).Interior.Color

Application.EnableEvents = True
End Sub

Sub Total_Boxes_Maintain()
Application.EnableEvents = False

MsgBox "シガーボックス数エラー"
Dim Count_Boxes As Long
Dim i As Long
Count_Boxes = 0
For i = 0 To (Max_Boxes - 1)
    If Cells(5, 3 + i).Borders(xlEdgeRight).LineStyle = xlContinuous Then
       Count_Boxes = Count_Boxes + 1
    Else
       Exit For
    End If
Next i
If Count_Boxes = 0 Then
    MsgBox "シガーボックス数0エラー:初期化をおすすめします"
End If
Cells(3, 3).Value = Count_Boxes

Application.EnableEvents = True
End Sub

Sub Set_N_Boxes() '箱数セット
Application.EnableEvents = False

Dim Total_Boxes As Long
Total_Boxes = Cells(3, 3).Value
If Total_Boxes > Max_Boxes Then
    MsgBox "シガーボックスを" & Max_Boxes & "個にします"
    Total_Boxes = Max_Boxes
End If
Cells(3, 3).Value = Total_Boxes

'' 一旦すべての設定用シガーボックスを消す→再構成
Range(Cells(5, 3), Cells(8, 2 + Max_Boxes)).Clear
Range(Cells(5, 3), Cells(5, 2 + Total_Boxes)).Borders.LineStyle = True
Range(Cells(7, 3), Cells(7, 2 + Total_Boxes)).Borders.LineStyle = True

Dim temparray As Variant
ReDim temparray(1 To 4, 1 To Total_Boxes)
Dim i As Long
For i = 1 To Total_Boxes
    temparray(1, i) = i
    temparray(2, i) = 0
    temparray(3, i) = i + 1
    temparray(4, i) = 0
Next i
temparray(3, Total_Boxes) = 1
temparray(4, Total_Boxes) = 1
Range(Cells(5, 3), Cells(8, 2 + Total_Boxes)).Value = temparray

Range(Cells(5, 3), Cells(5, 2 + Total_Boxes)).Interior.Color = Cells(3, 5).Interior.Color
Range(Cells(7, 3), Cells(7, 2 + Total_Boxes)).Interior.Color = Cells(3, 5).Interior.Color
Cells(7, 2 + Total_Boxes).Interior.Color = Cells(3, 6).Interior.Color

Application.EnableEvents = True
End Sub

Sub Set_N_Colors() '色数セット
Application.EnableEvents = False

Dim Total_Color As Long

If IsNumeric(Cells(3, 4).Value) = False Then
    MsgBox "色数エラー"
    Total_Color = 2
ElseIf Cells(3, 4).Value < 1 Then
    MsgBox "色数エラー"
    Total_Color = 2
ElseIf Cells(3, 4).Value > Max_Color Then
    MsgBox "色数を" & Max_Color & "にします"
    Total_Color = Max_Color
Else
    Total_Color = Cells(3, 4).Value
End If
Cells(3, 4).Value = Total_Color

Dim temparray As Variant
ReDim temparray(1 To 1, 1 To Total_Color)
Dim i As Long
For i = 1 To Total_Color
    temparray(1, i) = i - 1
Next i
Range(Cells(2, 5), Cells(2, 4 + Max_Color)).Clear
Range(Cells(2, 5), Cells(2, 4 + Total_Color)).Value = temparray

Application.EnableEvents = True
End Sub

Sub Set_Total_Trial() '回数セット
Application.EnableEvents = False

If IsNumeric(Cells(8, 1).Value) = False Then
    MsgBox "回数エラー"
    Cells(8, 1).Value = 8
ElseIf Cells(8, 1).Value < 1 Then
    MsgBox "回数エラー"
    Cells(8, 1).Value = 8
ElseIf Cells(8, 1).Value > Max_Trial Then
    MsgBox "試行回数を" & Max_Trial & "回にします。この制限は定数Max_Trialで決められています。"
    Cells(8, 1).Value = Max_Trial
End If
Cells(8, 1).Value = Int(Cells(8, 1).Value)

Application.EnableEvents = True
End Sub

Sub Delete_boxes() '生成したシガーボックスを消す
Application.EnableEvents = False

Cells(iRow, iColumn).Resize(Max_Trial * 2 + 1, Max_Boxes).Clear
Cells(10, 1).Value = 0
Cells(12, 1).Value = 0

Application.EnableEvents = True
End Sub

Sub Initialize_sheet() 'デフォルトにする
Application.EnableEvents = False
Application.ScreenUpdating = False

Cells.Clear 'シートをクリア（たぶん）
Range("A1") = "初期化"
Range("A2") = "実行"
Range("A3") = "箱消し"
Range("A5") = "何回する？"
Range("A6") = "上限固定"
Range("A7") = "上限回数"
Range("A8") = 8
Range("A9") = "区別なし周期"
Range("A10,A12") = 0
Range("A11") = "区別あり周期"
Range("B5,B7") = "順番"
Range("B6,B8") = "色"
Range("C1") = "A1～A3,A6:ダブルクリックしてください。5行～8行の（順番・色）より右：数入力で指定してください。C3・D3：数入力。E3・F3・以降右：カラーパレット。"
Range("C2") = "箱数"
Range("C3") = 3
Range("D2") = "色数"
Range("D3") = 2
Range("E3").Interior.Color = rgbYellow
Range("F3").Interior.Color = rgbRed
Range("A9:M9").Borders(xlEdgeTop).LineStyle = xlContinuous
Range("B5:B8").HorizontalAlignment = xlRight
Call Set_N_Colors
Call Set_N_Boxes

Application.ScreenUpdating = True
Application.EnableEvents = True

MsgBox "初期化完了"
End Sub

Sub Change_endurance_type() '試行の終わり方
Application.EnableEvents = False

If Cells(6, 1).Value = "上限固定" Then
    Cells(6, 1).Value = "区別あり周期"
ElseIf Cells(6, 1).Value = "区別あり周期" Then
    Cells(6, 1).Value = "区別なし周期"
Else
    Cells(6, 1).Value = "上限固定"
End If
Application.EnableEvents = True
End Sub

Sub Execute_main_process()
Application.EnableEvents = False
''準備
Call Delete_boxes
Dim Stop_Flag As Long
If Cells(6, 1).Value = "区別あり周期" Then
    Stop_Flag = 1
ElseIf Cells(6, 1).Value = "区別なし周期" Then
    Stop_Flag = 2
Else
    Cells(6, 1).Value = "上限固定"
    Stop_Flag = 0
End If

''置換を作成・検証
Dim Total_Boxes As Long
Total_Boxes = Cells(3, 3).Value
Dim permutation() As Long
ReDim permutation(Total_Boxes - 1)
Dim pmatrix() As Boolean
ReDim pmatrix(Total_Boxes - 1, Total_Boxes - 1)
Dim i As Long, j As Long
Dim icheck As Long, jcheck As Long
Dim pbefore As Variant, pafter As Variant
For i = 0 To (Total_Boxes - 1)
    permutation(i) = -1
    pbefore = Cells(5, 3 + i).Value
    icheck = 0
    For j = 0 To (Total_Boxes - 1)
        pmatrix(i, j) = False
        pafter = Cells(7, 3 + j).Value
        If pbefore = pafter Then
            pmatrix(i, j) = True
            permutation(i) = j
            icheck = icheck + 1
        End If
    Next j
    If icheck <> 1 Then
        MsgBox "シガーボックスの入れ替えが正しくありません"
        Exit Sub
    End If
Next i
For j = 0 To (Total_Boxes - 1)
    jcheck = 0
    For i = 0 To (Total_Boxes - 1)
        If pmatrix(i, j) Then
            jcheck = jcheck + 1
        End If
    Next i
    If jcheck <> 1 Then
        MsgBox "シガーボックスの入れ替えが正しくありません"
        Exit Sub
    End If
Next j

''色遷移を作成
Dim Total_Color As Long
Total_Color = Cells(3, 4).Value
Dim Color_Change() As Long
ReDim Color_Change(Total_Boxes - 1)
For i = 0 To (Total_Boxes - 1)
    Color_Change(i) = (Cells(8, 3 + permutation(i)).Value - Cells(6, 3 + i).Value + Total_Color) Mod Total_Color
Next i

Dim nowColor_Array() As Long
ReDim nowColor_Array(Total_Boxes - 1)
Dim nextColor_Array() As Long
ReDim nextColor_Array(Total_Boxes - 1)
Dim primColor_Array() As Long
ReDim primColor_Array(Total_Boxes - 1)
For i = 0 To (Total_Boxes - 1)
    nowColor_Array(i) = Cells(6, 3 + i).Value
    primColor_Array(i) = nowColor_Array(i)
Next i

''１つ目の試行を作成
Cells(iRow, iColumn).Resize(1, Total_Boxes).Borders.LineStyle = True
Cells(iRow, iColumn).Resize(1, Total_Boxes).Value = Cells(5, 3).Resize(1, Total_Boxes).Value
For i = 0 To (Total_Boxes - 1)
    Cells(iRow, iColumn + i).Interior.Color = Cells(5, 3 + i).Interior.Color
Next i

''前試行から次の試行を作成
Dim k As Long
Dim Total_Trial As Long
Total_Trial = Cells(8, 1).Value
Dim Return_Flag As Boolean
Dim period1 As Long
Dim period2 As Long

For k = 1 To Total_Trial
    If Wait_Flag Then
        Application.Wait [Now() + "0:00:00.5"] '0.5秒wait
    End If
    ''シガーボックス生成
    Cells(iRow + k * 2, iColumn).Resize(1, Total_Boxes).Borders.LineStyle = True
    For i = 0 To (Total_Boxes - 1)
        Cells(iRow + k * 2, iColumn + permutation(i)).Value = Cells(iRow + k * 2 - 2, iColumn + i).Value
        nextColor_Array(permutation(i)) = (nowColor_Array(i) + Color_Change(i)) Mod Total_Color
        Cells(iRow + k * 2, iColumn + permutation(i)).Interior.Color = Cells(3, 5 + nextColor_Array(permutation(i))).Interior.Color
    Next i
    For i = 0 To (Total_Boxes - 1)
        nowColor_Array(i) = nextColor_Array(i)
    Next i
    ''周期判定
    If period2 = 0 Then
        If period1 = 0 Then ''区別なし周期
            Return_Flag = True
            For i = 0 To (Total_Boxes - 1)
                If nowColor_Array(i) <> primColor_Array(i) Then
                    Return_Flag = False
                End If
            Next i
            If Return_Flag = True Then
                period1 = k
                Cells(10, 1).Value = period1
            End If
        End If
        If period1 <> 0 Then ''区別あり周期
            If k Mod period1 = 0 Then
                Return_Flag = True
                For i = 0 To (Total_Boxes - 1)
                    If Cells(iRow + k * 2, iColumn + i).Value <> Cells(iRow, iColumn + i).Value Then
                        Return_Flag = False
                    End If
                Next i
                If Return_Flag = True Then
                    period2 = k
                    Cells(12, 1).Value = period2
                End If
                If Stop_Flag = 2 Then ''離脱
                    Exit For
                ElseIf Stop_Flag = 1 And period2 > 0 Then
                    Exit For
                End If
            End If
        End If
    End If
Next k

If Achieve_Flag Then
    MsgBox "終了"
End If

Application.EnableEvents = True
End Sub