標題:
[發問]
用勾選讓儲存格不能等於
[打印本頁]
作者:
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
試試看
Option Explicit
Private Sub Workbook_Open() 'ThisWorkbook 模組的程式碼,開檔時自動執行
Dim xWeek, xM, Rng(0 To 2) As Range, i As Integer, ii As Integer
For Each xM In ActiveWorkbook.Names
xM.Delete
Next
xWeek = Split("星期一,星期二,星期三,星期四,星期五", ",")
xM = Split("早上,下午,晚上", ",")
With Sheets("課表雛形")
Set Rng(0) = .Range("D3:D18") '早上時段 '如有不對請自行修改
Set Rng(1) = .Range("D19:D34") '下午時段
Set Rng(2) = .Range("D35:D42") '晚上時段
For i = 0 To 4
For ii = 0 To 2
Rng(ii).Offset(, i).Name = xWeek(i) & xM(ii)
Next
Next
End With
End Sub
複製代碼
"課表雛形" 工作表模組的程式碼
Option Explicit Private
Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If 時段(Target) Then Target = ""
Application.EnableEvents = True
End Sub
Private Function 時段(xRng As Range) As Boolean '傳回 False 成為 0 ,而 True 成為 -1
Dim xR As String, N As Name, C As CheckBox
For Each N In ActiveWorkbook.Names
If Not Application.Intersect(Range(N), xRng) Is Nothing Then
xR = N.Name '取得 星期上下晚的時段
Exit For
End If
Next
With Sheets("老師不排課時段")
For Each C In .CheckBoxes
If .Cells(C.TopLeftCell.Row, 1) = xRng And C = 1 Then
If xR = .Cells(1, C.TopLeftCell.Column).MergeArea.Cells(1) & C.TopLeftCell.End(xlUp) Then
'星期的時段 .Cells(1, C.TopLeftCell.Column).MergeArea.Cells(1)
'上下晚的時段 C.TopLeftCell.End(xlUp)
時段 = True
MsgBox xRng & vbLf & xR & vbLf & "不排課程"
Exit For
End If
End If
Next
End With
End Function
複製代碼
作者:
j88141
時間:
2014-2-7 15:22
好
我來試試看
謝謝版主回復
作者:
Hsieh
時間:
2014-2-7 15:32
本帖最後由 Hsieh 於 2014-2-10 14:56 編輯
回復
4#
j88141
課表雛形工作表模組
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
k = Target.Column
r = Target.Row
w = Cells(2, k)
t = IIf(r <= 22, "早上", IIf(r > 22 And r <= 38, "下午", "晚上"))
If Target<>"" And Check(w & t, Target) > 0 Then MsgBox "該教師此時段不排課": Target.ClearContents
Application.EnableEvents = True
End Sub
Function Check(mystr$, MyVal)
Dim Ob As Shape, A As Range, Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
With 工作表1
For Each Ob In .Shapes
If Ob.OLEFormat.Object.Value = 1 Then
Set A = Ob.TopLeftCell
w = .Cells(1, A.Column).MergeArea(1)
t = .Cells(3, A.Column)
Dic(w & t) = IIf(Dic(w & t) = "", .Cells(A.Row, 1), Dic(w & t) & "," & .Cells(A.Row, 1))
End If
Next
Check = InStr(Dic(mystr), MyVal)
End With
End Function
複製代碼
[attach]17449[/attach]
作者:
j88141
時間:
2014-2-7 17:22
可不可以請版主一一解釋每一行
因為我還剛接觸excel vba
所以大部分都不太了解為什麼要這樣做
謝謝回我的每個人
作者:
yen956
時間:
2014-2-8 17:41
'Sheets("可排課時段")
Private Sub CommandButton1_Click()
Dim x, y As Object
Dim obj As OLEObject
Dim c終點, r終點, i, j, k As Integer
Dim tf As Boolean
Set x = Sheets("可排課時段")
Set y = Sheets("大課表")
x.Range("B50:R100").ClearContents
r終點 = x.[A4].End(xlDown).Row
c終點 = x.[B4].End(xlToRight).Column
For C = 2 To c終點
k = 49
For r = 4 To r終點
If x.Cells(r, C) Then
k = k + 1
x.Cells(k, C) = x.Cells(r, 1)
End If
Next
Next
j = 2
For Each obj In y.OLEObjects
If TypeOf obj.Object Is MSForms.ComboBox Then
obj.Object.Clear
c1 = x.Cells(49, j).End(xlDown).Row
For i = 50 To c1
obj.Object.AddItem x.Cells(i, j)
Next
j = j + 1
If j > j1 Then Exit Sub
End If
Next
End Sub
複製代碼
圖:可排課時段(執行結果)
'Sheets("大課表")
Private Sub ComboBox1_Change()
Dim x, y As Object
Set x = Sheets("大課表")
Set y = Sheets("可排課時段")
c1 = 3
c2 = 22
If ActiveCell.Column < r1 Or ActiveCell.Column > r2 Then Exit Sub
r1 = 5
r2 = 10
If ActiveCell.Row < c1 Or ActiveCell.Row > c2 Then Exit Sub
ActiveCell = ComboBox1.Text
End Sub
Private Sub ComboBox2_Change()
Dim x, y As Object
Set x = Sheets("大課表")
Set y = Sheets("可排課時段")
c1 = 23
c2 = 38
If ActiveCell.Column < r1 Or ActiveCell.Column > r2 Then Exit Sub
r1 = 5
r2 = 10
If ActiveCell.Row < c1 Or ActiveCell.Row > c2 Then Exit Sub
ActiveCell = ComboBox2.Text
End Sub
'以下請自行複製, 自行改
複製代碼
圖:大課表(執行結果)
作者:
yen956
時間:
2014-2-8 17:53
本帖最後由 yen956 於 2014-2-8 17:55 編輯
因為無權下載檔案, 故只好自已另外構想,
根據第一篇文章, 板主好像準備直接
在班級課表上排課, 這易排出某教師
在同時段在不同兩班授課的課表, 宜避免
電腦排課是一大工程, 市上許多現成的(附原代碼), 可參考參看看!
如:
簡易電腦排課系統【周文光】
https://www.google.com.tw/url?sa ... q-s4qn92Ls_9Xd0In2w
附原程式列表(節錄)
#include <stdio.h>
FILE *fp; /* 宣告檔案指標,提供開啟存放輸出結果的檔案 */
int mask_array[8][5]; /* 宣告mask_array陣列,提供程式判斷可供排課的時段 */
int data_array[20][12]; /* 宣告data_array陣列,提供存放輸入資料 */
struct class_unit { /* 宣告class_unit的結構,提供存放: */
int teacher_level; /* 教師職等(teacher_level) */
int teacher_no; /* 教師編號(teacher_no) */
int score_no; /* 科目編號(score_no) */
int flag; /* 用來判斷教室是否可供排課的旗標(flag) */
};
struct class_unit classroom[4][8][5]; /* 以class_unit的結構宣告一個classroom陣列 */
void clear_classroom() { /* clear_classroom()副程式 */
int i, j, k; /* 用來設定classroom陣列的初始值為0 */
for(i=0; i<4; i++) {
for(j=0; j<8; j++) {
for(k=0; k<5; k++) {
classroom[i][j][k].teacher_level=0; /* 設定教師職等(teacher_level)為0 */
classroom[i][j][k].teacher_no=0; /* 設定教師編號(teacher_no)為0 */
classroom[i][j][k].score_no=0; /* 設定科目編號(score_no)為0 */
classroom[i][j][k].flag=0; /* 設定用來判斷教室是否可供排課的旗標(flag)為0 */
}
}
}
}
複製代碼
作者:
j88141
時間:
2014-2-9 09:29
如果以大課表來排的話,好像很多東西都可以變成比較簡單
市上我知道很多現成的,但是像C語言跟excel的程式碼就不一樣了
不過還是謝謝提供這個程式碼
我來慢慢看
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)