12
返回列表 上一主題 發帖

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

j88141

帖子
46 
主題
10 
精華
0 
積分
88 
點名
0  
作業系統
WIN10 
軟體版本
excel2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2014-1-27 
最後登錄
2018-3-30 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2014-2-7 09:55 | 只看該作者

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

我想問一個問題

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

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

j88141

帖子
46 
主題
10 
精華
0 
積分
88 
點名
0  
作業系統
WIN10 
軟體版本
excel2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2014-1-27 
最後登錄
2018-3-30 
11#
發表於 2014-2-9 09:29 | 只看該作者
如果以大課表來排的話，好像很多東西都可以變成比較簡單
市上我知道很多現成的，但是像C語言跟excel的程式碼就不一樣了
不過還是謝謝提供這個程式碼
我來慢慢看

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
10#
發表於 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>

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

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

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

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

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

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
9#
發表於 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

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

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

TOP

j88141

帖子
46 
主題
10 
精華
0 
積分
88 
點名
0  
作業系統
WIN10 
軟體版本
excel2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2014-1-27 
最後登錄
2018-3-30 
8#
發表於 2014-2-7 17:22 | 只看該作者
可不可以請版主一一解釋每一行
因為我還剛接觸excel vba
所以大部分都不太了解為什麼要這樣做
謝謝回我的每個人

TOP

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
257  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2024-11-27 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 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
複製代碼
學海無涯_不恥下問

TOP

j88141

帖子
46 
主題
10 
精華
0 
積分
88 
點名
0  
作業系統
WIN10 
軟體版本
excel2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2014-1-27 
最後登錄
2018-3-30 
6#
發表於 2014-2-7 15:22 | 只看該作者
好
我來試試看
謝謝版主回復

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

j88141

帖子
46 
主題
10 
精華
0 
積分
88 
點名
0  
作業系統
WIN10 
軟體版本
excel2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2014-1-27 
最後登錄
2018-3-30 
4#
發表於 2014-2-7 10:47 | 只看該作者
因為我現在是想做排課表
但老師的不排課時段是需要勾選的 後面還有星期二 ... 星期三...(還未做核取方塊)
所以才會在 表二 的星期一早上中放置   王小平  的核取方塊
並且勾選後  不讓表一的星期一早上出現王小平

TOP

j88141

帖子
46 
主題
10 
精華
0 
積分
88 
點名
0  
作業系統
WIN10 
軟體版本
excel2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2014-1-27 
最後登錄
2018-3-30 
3#
發表於 2014-2-7 10:42 | 只看該作者
不好意思   附上檔案 附件.rar (40.45 KB)

TOP

        靜思自在 : 人生最大的成就是從失敗中站起來。
12
返回列表 上一主題