返回列表 上一主題 發帖

[發問] 用勾選讓儲存格不能等於

[發問] 用勾選讓儲存格不能等於

我想問一個問題

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

那是否可以讓(第一張)紅色圈圈內不能打出王小平這三個字
或是打出王小平三個字後會出現警示訊息

回復 1# j88141
既然不想讓 王小平 出現在 表一 的星期一早上的名單中,
那為何要在 表二 的星期一早上中放置  王小平 的核取方塊?

TOP

不好意思   附上檔案 附件.rar (40.45 KB)

TOP

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

TOP

本帖最後由 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP


我來試試看
謝謝版主回復

TOP

本帖最後由 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
複製代碼
學海無涯_不恥下問

TOP

可不可以請版主一一解釋每一行
因為我還剛接觸excel vba
所以大部分都不太了解為什麼要這樣做
謝謝回我的每個人

TOP

  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. '以下請自行複製, 自行改
複製代碼
圖:大課表(執行結果)

TOP

本帖最後由 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. }
複製代碼

TOP

        靜思自在 : 人的心地是一畦田,土地沒有播下好種子,也長不出好的果實。 -
返回列表 上一主題