Board logo

標題: [發問] 用勾選讓儲存格不能等於 [打印本頁]

作者: j88141    時間: 2014-2-7 09:55     標題: 用勾選讓儲存格不能等於

我想問一個問題

如果再王小平  的星期一早上打勾的話 (圖第二張)

那是否可以讓(第一張)紅色圈圈內不能打出王小平這三個字
或是打出王小平三個字後會出現警示訊息
[attach]17447[/attach]
作者: yen956    時間: 2014-2-7 10:41

回復 1# j88141
既然不想讓 王小平 出現在 表一 的星期一早上的名單中,
那為何要在 表二 的星期一早上中放置  王小平 的核取方塊?
作者: j88141    時間: 2014-2-7 10:42

不好意思   附上檔案[attach]17448[/attach]
作者: j88141    時間: 2014-2-7 10:47

因為我現在是想做排課表
但老師的不排課時段是需要勾選的 後面還有星期二 ... 星期三...(還未做核取方塊)
所以才會在 表二 的星期一早上中放置   王小平  的核取方塊
並且勾選後  不讓表一的星期一早上出現王小平
作者: GBKEE    時間: 2014-2-7 14:17

本帖最後由 GBKEE 於 2014-2-7 17:39 編輯

回復 4# j88141
試試看
  1. Option Explicit
  2. Private Sub Workbook_Open()    'ThisWorkbook 模組的程式碼,開檔時自動執行
  3.     Dim xWeek, xM, Rng(0 To 2) As Range, i As Integer, ii As Integer
  4.     For Each xM In ActiveWorkbook.Names
  5.         xM.Delete
  6.     Next
  7.     xWeek = Split("星期一,星期二,星期三,星期四,星期五", ",")
  8.     xM = Split("早上,下午,晚上", ",")
  9.    
  10.     With Sheets("課表雛形")
  11.         Set Rng(0) = .Range("D3:D18")       '早上時段  '如有不對請自行修改
  12.         Set Rng(1) = .Range("D19:D34")      '下午時段
  13.         Set Rng(2) = .Range("D35:D42")      '晚上時段
  14.         For i = 0 To 4
  15.             For ii = 0 To 2
  16.                 Rng(ii).Offset(, i).Name = xWeek(i) & xM(ii)
  17.             Next
  18.         Next
  19.     End With
  20. End Sub
複製代碼
"課表雛形" 工作表模組的程式碼
  1. Option Explicit Private
  2. Sub Worksheet_Change(ByVal Target As Range)
  3.     Application.EnableEvents = False
  4.     If 時段(Target) Then Target = ""
  5.     Application.EnableEvents = True
  6. End Sub
  7. Private Function 時段(xRng As Range) As Boolean   '傳回 False 成為 0 ,而 True 成為 -1
  8.     Dim xR As String, N As Name, C As CheckBox
  9.     For Each N In ActiveWorkbook.Names
  10.         If Not Application.Intersect(Range(N), xRng) Is Nothing Then
  11.             xR = N.Name              '取得 星期上下晚的時段
  12.             Exit For
  13.         End If
  14.     Next
  15.     With Sheets("老師不排課時段")
  16.         For Each C In .CheckBoxes
  17.            If .Cells(C.TopLeftCell.Row, 1) = xRng And C = 1 Then
  18.                If xR = .Cells(1, C.TopLeftCell.Column).MergeArea.Cells(1) & C.TopLeftCell.End(xlUp) Then
  19.                     '星期的時段    .Cells(1, C.TopLeftCell.Column).MergeArea.Cells(1)
  20.                     '上下晚的時段  C.TopLeftCell.End(xlUp)
  21.                     時段 = True
  22.                     MsgBox xRng & vbLf & xR & vbLf & "不排課程"
  23.                     Exit For
  24.                 End If
  25.            End If
  26.         Next
  27.     End With
  28. End Function
複製代碼

作者: j88141    時間: 2014-2-7 15:22


我來試試看
謝謝版主回復

作者: Hsieh    時間: 2014-2-7 15:32

本帖最後由 Hsieh 於 2014-2-10 14:56 編輯

回復 4# j88141
課表雛形工作表模組
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. If Target.Count > 1 Then Exit Sub
  3. Application.EnableEvents = False
  4. k = Target.Column
  5. r = Target.Row
  6. w = Cells(2, k)
  7. t = IIf(r <= 22, "早上", IIf(r > 22 And r <= 38, "下午", "晚上"))
  8. If Target<>"" And Check(w & t, Target) > 0 Then MsgBox "該教師此時段不排課": Target.ClearContents
  9. Application.EnableEvents = True
  10. End Sub
  11. Function Check(mystr$, MyVal)
  12. Dim Ob As Shape, A As Range, Dic As Object
  13. Set Dic = CreateObject("Scripting.Dictionary")
  14. With 工作表1
  15. For Each Ob In .Shapes
  16.    If Ob.OLEFormat.Object.Value = 1 Then
  17.       Set A = Ob.TopLeftCell
  18.       w = .Cells(1, A.Column).MergeArea(1)
  19.       t = .Cells(3, A.Column)
  20.       Dic(w & t) = IIf(Dic(w & t) = "", .Cells(A.Row, 1), Dic(w & t) & "," & .Cells(A.Row, 1))
  21.    End If
  22. Next
  23. Check = InStr(Dic(mystr), MyVal)
  24. End With
  25. End Function
複製代碼
[attach]17449[/attach]
作者: j88141    時間: 2014-2-7 17:22

可不可以請版主一一解釋每一行
因為我還剛接觸excel vba
所以大部分都不太了解為什麼要這樣做
謝謝回我的每個人
作者: yen956    時間: 2014-2-8 17:41

  1. 'Sheets("可排課時段")
  2.    
  3. Private Sub CommandButton1_Click()
  4.    Dim x, y As Object
  5.    Dim obj As OLEObject
  6.    Dim c終點, r終點, i, j, k As Integer
  7.    Dim tf As Boolean
  8.    Set x = Sheets("可排課時段")
  9.    Set y = Sheets("大課表")
  10.    
  11.    x.Range("B50:R100").ClearContents
  12.    r終點 = x.[A4].End(xlDown).Row
  13.    c終點 = x.[B4].End(xlToRight).Column
  14.    For C = 2 To c終點
  15.       k = 49
  16.       For r = 4 To r終點
  17.          If x.Cells(r, C) Then
  18.             k = k + 1
  19.             x.Cells(k, C) = x.Cells(r, 1)
  20.          End If
  21.       Next
  22.    Next
  23.    
  24.    j = 2
  25.    For Each obj In y.OLEObjects
  26.       If TypeOf obj.Object Is MSForms.ComboBox Then
  27.          obj.Object.Clear
  28.          c1 = x.Cells(49, j).End(xlDown).Row
  29.          For i = 50 To c1
  30.             obj.Object.AddItem x.Cells(i, j)
  31.          Next
  32.          j = j + 1
  33.          If j > j1 Then Exit Sub
  34.       End If
  35.    Next
  36. End Sub
複製代碼
圖:可排課時段(執行結果)
  1. 'Sheets("大課表")
  2. Private Sub ComboBox1_Change()
  3.    Dim x, y As Object
  4.    Set x = Sheets("大課表")
  5.    Set y = Sheets("可排課時段")
  6.    
  7.    c1 = 3
  8.    c2 = 22
  9.    If ActiveCell.Column < r1 Or ActiveCell.Column > r2 Then Exit Sub
  10.    
  11.    r1 = 5
  12.    r2 = 10
  13.    If ActiveCell.Row < c1 Or ActiveCell.Row > c2 Then Exit Sub
  14.    
  15.    ActiveCell = ComboBox1.Text
  16. End Sub

  17. Private Sub ComboBox2_Change()
  18.    Dim x, y As Object
  19.    Set x = Sheets("大課表")
  20.    Set y = Sheets("可排課時段")
  21.    
  22.    c1 = 23
  23.    c2 = 38
  24.    If ActiveCell.Column < r1 Or ActiveCell.Column > r2 Then Exit Sub
  25.    
  26.    r1 = 5
  27.    r2 = 10
  28.    If ActiveCell.Row < c1 Or ActiveCell.Row > c2 Then Exit Sub
  29.    
  30.    ActiveCell = ComboBox2.Text
  31. End Sub

  32. '以下請自行複製, 自行改
複製代碼
圖:大課表(執行結果)

作者: yen956    時間: 2014-2-8 17:53

本帖最後由 yen956 於 2014-2-8 17:55 編輯

因為無權下載檔案, 故只好自已另外構想,
根據第一篇文章, 板主好像準備直接
在班級課表上排課, 這易排出某教師
在同時段在不同兩班授課的課表, 宜避免

電腦排課是一大工程, 市上許多現成的(附原代碼), 可參考參看看!
如:
簡易電腦排課系統【周文光】
https://www.google.com.tw/url?sa ... q-s4qn92Ls_9Xd0In2w
附原程式列表(節錄)
  1. #include <stdio.h>

  2. FILE *fp;                                     /* 宣告檔案指標,提供開啟存放輸出結果的檔案 */
  3. int mask_array[8][5];                         /* 宣告mask_array陣列,提供程式判斷可供排課的時段 */
  4. int data_array[20][12];                       /* 宣告data_array陣列,提供存放輸入資料 */

  5. struct class_unit {                           /* 宣告class_unit的結構,提供存放: */
  6.   int teacher_level;                          /* 教師職等(teacher_level) */
  7.   int teacher_no;                             /* 教師編號(teacher_no) */
  8.   int score_no;                               /* 科目編號(score_no) */
  9.   int flag;                                   /* 用來判斷教室是否可供排課的旗標(flag) */
  10. };

  11. struct class_unit classroom[4][8][5];         /* 以class_unit的結構宣告一個classroom陣列 */

  12. void clear_classroom() {                      /* clear_classroom()副程式 */
  13.   int i, j, k;                                /* 用來設定classroom陣列的初始值為0 */

  14.   for(i=0; i<4; i++) {
  15.     for(j=0; j<8; j++) {
  16.       for(k=0; k<5; k++) {
  17.         classroom[i][j][k].teacher_level=0;   /* 設定教師職等(teacher_level)為0 */
  18.         classroom[i][j][k].teacher_no=0;      /* 設定教師編號(teacher_no)為0 */
  19.         classroom[i][j][k].score_no=0;        /* 設定科目編號(score_no)為0 */
  20.         classroom[i][j][k].flag=0;            /* 設定用來判斷教室是否可供排課的旗標(flag)為0 */
  21.       }
  22.     }
  23.   }
  24. }
複製代碼

作者: j88141    時間: 2014-2-9 09:29

如果以大課表來排的話,好像很多東西都可以變成比較簡單
市上我知道很多現成的,但是像C語言跟excel的程式碼就不一樣了
不過還是謝謝提供這個程式碼
我來慢慢看




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)