Private Sub pkzx()
'Second(Time)
'On Error GoTo finish
Dim weizi, x, y, j1, j2 As Integer
YuPK '冒泡排序空間法
Set kc4 = cnn.Execute("select * from 空間明細 order by 剩余空間 asc")
Do While Not kc4.EOF '當指標沒有到達檔案結尾時，繼續回圈，而一旦指標到達檔案結尾，則停止回圈。
For hang = 1 To Grid1.Rows - 1
If Grid1.Cell(hang, 1).Text = kc4.Fields(0) Then
Exit For '退出for回圈
End If
gridcs '執行程序,此程序主要是運行陣列比對,讀取可用的教師資源和班級資源用
grid4hq '這里是將可用的教師資源和班級資源進行對比,得出需要的結果
If Grid04.Rows <= 1 Then
Set kc4 = cnn.Execute("delete * from 空間明細")
MsgBox "本次生成課表時系統遇到不可預料故障,請檢查各項設定,并注銷課程表重新生成！"
GoTo 1
End If
'通過比較得到較適當的課程位置
Dim Gint(7) As Integer '存取當前課程的各天空間
Dim Statint(7) As Integer '存盤每一天首位值
For i = 0 To 6
Gint(i) = 0
Statint(i) = 0
Next
Dim MXstr() As Integer '明細陣列
'MXstr = Split(kc4.Fields(2), ";")
For i = 1 To Grid4.Rows - 1
Dim MXInt As Integer
MXInt = Round(Grid4.Cell(i, 1).Text / nknumber)
If MXInt < Grid4.Cell(i, 1).Text / nknumber Then
MXInt = MXInt + 1
End If
Select Case MXInt '獲取每天的分布情況
Case 1
Gint(0) = Gint(0) + 1
If Statint(0) = 0 Then
Statint(0) = Grid4.Cell(i, 1).Text
End If
Case 2
Gint(1) = Gint(1) + 1
If Statint(1) = 0 Then
Statint(1) = Grid4.Cell(i, 1).Text
End If
Case 3
Gint(2) = Gint(2) + 1
If Statint(2) = 0 Then
Statint(2) = Grid4.Cell(i, 1).Text
End If
Case 4
Gint(3) = Gint(3) + 1
If Statint(3) = 0 Then
Statint(3) = Grid4.Cell(i, 1).Text
End If
Case 5
Gint(4) = Gint(4) + 1
If Statint(4) = 0 Then
Statint(4) = Grid4.Cell(i, 1).Text
End If
Case 6
Gint(5) = Gint(5) + 1
If Statint(5) = 0 Then
Statint(5) = Grid4.Cell(i, 1).Text
End If
Case 7
Gint(6) = Gint(6) + 1
If Statint(6) = 0 Then
Statint(6) = Grid4.Cell(i, 1).Text
End If
End Select
Next
'----------此段為將分布結果排序
For i = 0 To 6
Set kc5 = cnn.Execute("insert into i values(" & Gint(i) & "," & Statint(i) & ")")
Next
Set kc5 = cnn.Execute("select * from i order by i desc")
For i = 0 To 6
Gint(i) = kc5.Fields(0)
Statint(i) = kc5.Fields(1)
kc5.MoveNext
Next
Set kc5 = cnn.Execute("delete * from i")
'-----------
'----------------------------
'----------------------------
For i = 1 To Grid1.Cell(hang, 3).Text / n '通過回圈為某個課程開始排表
weizi = Statint(i - 1) '等于最大值的列，相當于平均分配
'以下計算隨機出來的值,取向于課程有的某行某列
x = Round(weizi / nknumber)
If x < weizi / nknumber Then
x = x + 1
End If
y = weizi Mod nknumber ' mod是將兩數相除，將余數回傳
If y = 0 Then
If nknumber <> 7 Then
y = nknumber - 1
Else
y = nknumber
End If
End If
Select Case n
Case 1
Grid5.Cell(y, x).Text = Grid1.Cell(hang, 1).Text
array1(weizi) = "1"
array2(weizi) = "1"
XPPbr1.Value = XPPbr1.Value + 1
End Select
'以上XX="1"的部分都是實時對表格進行修改,以便后面將表格的資料提交到資料庫
Dim gsql1, gsql2 As String
gsql1 = ""
gsql2 = ""
For j1 = 1 To nknumber * 7 '以下是開始提交各表格的資料
If array1(j1) = "" Then
gsql1 = gsql1 & "0"
Else
gsql1 = gsql1 & array1(j1)
End If
Next
Set kc2 = cnn.Execute("update 占用 set 占用='" & gsql1 & "' where 教師姓名='" & Grid1.Cell(hang, 5).Text & "'")
'將修改的資料提交到資料庫中
For j2 = 1 To nknumber * 7
If array2(j2) = "" Then
gsql2 = gsql2 & "0"
Else
gsql2 = gsql2 & array2(j2)
End If
Next
Set kc2 = cnn.Execute("update 課程占用 set 占用='" & gsql2 & "' where 班級='" & XPCombo1.Text & "'")
Next
End If
kc4.MoveNext
Loop
1:
Dim gsql3 As String
For i = 1 To Grid5.Rows - 1 '以下是將生成的課表保存到資料庫中
gsql3 = "insert into 臨時生成表(時間段,星期一,星期二,星期三,星期四,星期五,星期六,星期日,所屬班級) values('"
For j = 0 To Grid5.Cols - 1
gsql3 = gsql3 & Grid5.Cell(i, j).Text & "','"
Next
gsql3 = gsql3 & XPCombo1.Text & "')"
Set kc3 = cnn.Execute(gsql3)
Next
'添加教師對應教學表
For i = 1 To Grid5.Rows - 1 '以下是將生成的課表保存到資料庫中
gsql3 = "insert into 對應教師表(時間段,一,二,三,四,五,六,日,班級) values('"
gsql3 = gsql3 & Grid5.Cell(i, 0).Text & "','"
For j = 1 To Grid5.Cols - 1
For k = 0 To Grid1.Rows - 1
If Grid5.Cell(i, j).Text = "" And k = Grid1.Rows - 1 Then
gsql3 = gsql3 & "','"
Else
If Grid1.Cell(k, 1).Text = Grid5.Cell(i, j).Text Then
gsql3 = gsql3 & Grid1.Cell(k, 5).Text & "','"
End If
End If
Next
Next
gsql3 = gsql3 & XPCombo1.Text & "')"
Set kc3 = cnn.Execute(gsql3)
Next
Exit Sub
'finish:
'MsgBox Err.Description
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/121751.html
標籤：VBA