Excel Maniacs

時間割自動作成(13)

【´･ω･`】：今回はまず、サブプロシージャ、Main_Partからだ。

　　　　　　まず見てくれ。

Sub Main_Part()
%Tanni_Total = Cells(13, 10)
    %i = 2
   
    For %j = 1 To 10000
        Randomize(ThisTime())            !!乱数の発生
        %X = Int(Rand() * 6 + 1)
        %Y = Int(Rand() * 6 + 1)
       
        %Tannisu = Cells(%i, 9)
      
            
        If Cells(%Y + 1, %X) = "" Then
          If Cells(%i, 9) > Cells(%i, 10) Then
            If Not Kamoku_Check(%X, %i) Then
                Cells(%Y + 1, %X) = Cells(%i, 8)
               
            End If
          End If
        End If
       
        If Cells(%i, 10) = %Tannisu Then
            
            %Limit = %Limit + Cells(%i, 10)
            %i = %i + 1
            If %Limit = %Tanni_Total Then
             Exit Sub
            End If
            
        End If
            
            
    Next
End Sub   

(●`ε´●)：なんだ、プロトタイプⅡのコードとやっていることは

　　　　　　同じだな。

【´･ω･`】：うん、まずPut2jikanで２時間続きの科目を書き込み、

　　　　　残りの科目を空いているところにMain_Partで書き込むだけだからな。

　　　　　一応全てのコードを掲載しておこう。

%MyRange=Range("B2:F7")
%Cnt=0
Do While %Cnt <10000
        Range("B2:F7")=%MyRange
        Put2Jikan
        Main_Part
        If Cells(13, 9) = Cells(13, 10) Then
         MsgBox("Done")
         Stop
        End If
        %Cnt =%Cnt+1
Loop
MsgBox("解が見つかりませんでした。")

Sub Main_Part()
%Tanni_Total = Cells(13, 10)
    %i = 2
   
    For %j = 1 To 10000
        Randomize(ThisTime())            !!乱数の発生
        %X = Int(Rand() * 6 + 1)
        %Y = Int(Rand() * 6 + 1)
       
        %Tannisu = Cells(%i, 9)
      
            
        If Cells(%Y + 1, %X) = "" Then
          If Cells(%i, 9) > Cells(%i, 10) Then
            If Not Kamoku_Check(%X, %i) Then
                Cells(%Y + 1, %X) = Cells(%i, 8)
               
            End If
          End If
        End If
       
        If Cells(%i, 10) = %Tannisu Then
            
            %Limit = %Limit + Cells(%i, 10)
            %i = %i + 1
            If %Limit = %Tanni_Total Then
             Exit Sub
            End If
            
        End If
            
            
    Next
End Sub   

Private Function Kamoku_Check(%Youbi, %Kamoku) As Boolean
    !!同一曜日に同じ科目がないかチェックする
    !!同じ科目があればTrueをかえす。
   
    Kamoku_Check = False
   
    %KamokuMei = Cells(%Kamoku, 8)
    For %i = 2 To 7
        If Cells(%i, %Youbi) = %KamokuMei Then
         Kamoku_Check = True
        End If
    Next
   
End Function

Sub Put2Jikan()
               
    %Limit = 0
   
    %i = 2
   
    For %j = 1 To 1000
        Randomize(ThisTime())            !!乱数の発生
        %X = Int(Rand() * 6 + 1)
        %Y = Int(Rand() * 6 + 1)
         
        If Cells(%i, 11) = 1 Then
            If %Y = 1 Or %Y = 2 Or %Y = 3 Or %Y = 5 Then
                 If Cells(%Y + 1, %X) = "" And \\
                       Cells(%Y + 1 + 1, %X) = "" Then
                  
                     If Not Kamoku_Check(%X, %i) Then
                         Cells(%Y + 1, %X) = Cells(%i, 8)
                         Cells(%Y + 1 + 1, %X) = Cells(%i, 8)
                         %i = %i + 1
                         %Limit = %Limit + 2
                     End If
                 End If
            
                
            End If
        Else
            %i = %i + 1
        End If
        If %i = 12 Then
         Exit Sub
        End If
    Next
   

End Sub

【´･ω･`】：これで当初の目標・・・・

• あらかじめ特定の科目を特定の曜日の特定の時間に組み込める。
• 同じ科目を同じ日に２時間履修することの無いようにする。
• ２時間続きの科目を設定できるようにする。

　　　　・・・は達成した。

サンプルファイルを用意したので試して欲しい。

使い方は・・・

1. 科目名を設定し・・・
2. 単位数を設定・・・（30単位になるように）・・・
3. 二時間続きにしたい科目には１を入力・・・
4. マクロ「時間割作成03」を実行。

snsSample011.lzhをダウンロード

三四郎マクロで時間割自動作成プログラムラムを作る・・・（終了）

時間割自動作成(12)

【´･ω･`】：下がサブプロシージャ、Put2jikanのコードだ。

(●`ε´●)：２時間続きの科目を書き込むコードだったな。

【´･ω･`】：うん。

Sub Put2Jikan()
               
    %Limit = 0
   
    %i = 2
   
    For %j = 1 To 1000
        Randomize(ThisTime())            !!乱数の発生
        %X = Int(Rand() * 6 + 1)
        %Y = Int(Rand() * 6 + 1)
       
       
       
       
        If Cells(%i, 11) = 1 Then
            If %Y = 1 Or %Y = 2 Or %Y = 3 Or %Y = 5 Then
                 If Cells(%Y + 1, %X) = "" And \\
                       Cells(%Y + 1 + 1, %X) = "" Then
                  
                     If Not Kamoku_Check(%X, %i) Then
                         Cells(%Y + 1, %X) = Cells(%i, 8)
                         Cells(%Y + 1 + 1, %X) = Cells(%i, 8)
                         %i = %i + 1
                         %Limit = %Limit + 2
                     End If
                 End If
            
                
            End If
        Else
            %i = %i + 1
        End If
        If %i = 12 Then
         Exit Sub
        End If
    Next
   

End Sub

【´･ω･`】：基本的にはプロトタイプⅡの「核になる部分」のコードと

　　　　　　やっていることは変わらない。

　　　　　　違いは・・・

　　　　　　If %Y = 1 Or %Y = 2 Or %Y = 3 Or %Y = 5 Then

　　　　　・・・で書き込むべき時間が１時間目、２時間目、３時間目

　　　　　あるいは５時間目になっているかをチェックする。

(●`ε´●)：４時間目だと、それに続く時間が５時間目になり

　　　　　　昼休みを挟むことになるので不可、６時間目だと

　　　　　　それに続く時間が存在しない７時間目になってしまうので

　　　　　　不可、というわけだな？

【´･ω･`】：うん、その通り。そしてさらに・・・

　　　　　　 If Cells(%Y + 1, %X) = "" And \\
                       Cells(%Y + 1 + 1, %X) = "" Then

　　　　　　・・・でその時間が空いているかをチェックする。

(●`ε´●)：大きな違いはそれだけか？

【´･ω･`】：うん。後はサブプロシージャMain_Partが残るだけだが

　　　　　眠くなったので次回回しだ。

時間割自動作成(11)

【´･ω･`】：下が時間割自動作成マクロプロトタイプⅢの核となる部分だ。

１：　　%MyRange=Range("B2:F7")
２：　　%Cnt=0
３：　　Do While %Cnt <10000
４：　　        Range("B2:F7")=%MyRange
５：　　        Put2Jikan
６：　　        Main_Part
７：　　        If Cells(13, 9) = Cells(13, 10) Then
８：　　　　         MsgBox("Done")
９：　　　　        Stop
10：　        End If
11：　        %Cnt =%Cnt+1
12：　Loop
１３：　MsgBox("解が見つかりませんでした。")

【´･ω･`】：説明のために行番号をふっておいた。

(●`ε´●)：たったの13行か？

【´･ω･`】：うん。・・・では解説しよう。

　　　　　　まず、1行目。ここで初期状態の時間割表を変数%MyRangeに

　　　　　　格納しておく。

(●`ε´●)：初期状態？

【´･ω･`】：うん。最初にユーザはあらかじめ、いくつかの科目は

　　　　　何曜日の何時間目と・・・指定しているかもしれない。

(●`ε´●)：この場合は火曜6限の「総合」と木曜6限の「LHR」の

　　　　　　ことか？

【´･ω･`】：そう。なんでこんなことをするかは後ですぐわかる。

(●`ε´●)：OK。それでは2行目は？

【´･ω･`】：ループカウンタの初期化だ。３行目から１２行目まで

　　　　　黙っていれば１００００回ループする。ここで適当に科目を

　　　　　割り振っていって、上手く割り振れればループを抜ける。

　　　　　まず、4行目で時間割表を初期状態にする・・・。

　　　　　関数Put2Jikanを呼び出して2時間続きの科目を時間割表に

　　　　　書き込む・・・。次に関数Main_Partを呼び出し、2時間続きではない

　　　　　科目を時間割表に書き込む。

　　　　　次に7行目で全ての科目を時間割表に書き込めたかをチェックして

　　　　　書き込めていれば終了、そうでなければ4行目に戻る・・・。

　　　　　1万回ループしても解が見つからなければ、その旨を表示して

　　　　　プログラムを終了する。

(●`ε´●)：なるほど、書き込みに失敗した場合、時間割表にはいろいろと

　　　　　　科目が書き込まれてしまっているから、それを初期状態に戻せるように

　　　　　　1行目で・・・

　　　　　　%MyRange=Range("B2:F7")

　　　　　　・・・としておいたのか。

【´･ω･`】：うん。プログラムの流れがだいたい、わかったと思う。次回は

　　　　　サブルーチンのPut2Jikan　と  Main_Part　を見てみよう。