時間割自動作成(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をダウンロード

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

Comments

[投稿情報: 珍念]

さすがです。
ただ一つ気になったのは
他学年に出授業されている教科の先生をどう扱えばいいかです。

そこまでやるのは難しいんでしょうね。

[投稿情報: くまぷー]

珍念さん、コメントどもです。(^。^)

＞他学年に出授業されている教科の先生をどう扱えばいいかです。

他学年の教員とかの区別は必要ないと思います。

☆教員名まで時間割に割り振る場合
１．プロトタイプⅢ方式で複数クラスの
　時間割に教科名を割り振る。
２．教員と担当教科名を関連づける。
３．１で作った時間割の教科名をスキャン　して担当教員名を割り振っていく。（但し、同一教員名は同一曜日の同一時間には割り振れない）

なんてカンジでやればいいのでは？

教員名を割り振るプロトタイプⅣは
珍念さんに期待しま～」す(^。^)