123
返回列表 上一主題 發帖

[發問] 請問 ARRAY範圍 改成 動態 指定 範圍問題 請前輩們指教

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
1# 跳轉到 » 正序看帖
打印
tT
發表於 2020-6-15 13:42 | 只看該作者

[發問] 請問 ARRAY範圍 改成 動態 指定 範圍問題 請前輩們指教

Private Sub CommandButton2_Click()
'3個月
If TextBox2.Value = 1 Then A = Array(3, 5, 7, 15, 17, 19)
If TextBox2.Value = 2 Then A = Array(5, 7, 9, 17, 19, 21)
If TextBox2.Value = 3 Then A = Array(7, 9, 11, 19, 21, 23)
If TextBox2.Value = 4 Then A = Array(9, 11, 13, 21, 23, 25)
If TextBox2.Value = 5 Then A = Array(11, 13, 15, 23, 25)
If TextBox2.Value = 6 Then A = Array(13, 15, 17, 25)
If TextBox2.Value = 7 Then A = Array(15, 17, 19)
If TextBox2.Value = 8 Then A = Array(17, 19, 21)
If TextBox2.Value = 9 Then A = Array(19, 21, 23)
If TextBox2.Value = 10 Then A = Array(21, 23, 25)
If TextBox2.Value = 11 Then A = Array(23, 25)
If TextBox2.Value = 12 Then A = Array(25)
If TextBox2.Value = "" Then A = Array(3, 5, 7, 15, 17, 19)

For I = LBound(A) To UBound(A)
    For J = 4 To Cells(3, 4).End(xlToRight).Column
        If Cells(A(I), J) = "日班" Then Cells(A(I), J) = "夜班"
        If Cells(A(I), J) <> "" And Cells(A(I), J) = "夜班" Then
           Cells(A(I), J).Font.Color = RGB(Cells(1, 26), Cells(1, 27), Cells(1, 28))
           Cells(A(I), J).Interior.Color = RGB(Cells(1, 32), Cells(1, 33), Cells(1, 34))
        End If
    Next J
Next I
Erase A

UserForm3.Hide
TextBox2.Value = ""
End Sub

請問前輩們 以下這段該如何改寫 才能夠改成動態的規律 如何可以縮減程式碼
還有一個延伸問題 當延伸到最後一個月時不滿3個月 該如何延伸至下一年的第一個月
請前輩們指教 程式特別攏長 看起來可能會有些不方便 不好意思 ^^"

If TextBox2.Value = 1 Then A = Array(3, 5, 7, 15, 17, 19)
If TextBox2.Value = 2 Then A = Array(5, 7, 9, 17, 19, 21)
If TextBox2.Value = 3 Then A = Array(7, 9, 11, 19, 21, 23)
If TextBox2.Value = 4 Then A = Array(9, 11, 13, 21, 23, 25)
If TextBox2.Value = 5 Then A = Array(11, 13, 15, 23, 25)
If TextBox2.Value = 6 Then A = Array(13, 15, 17, 25)
If TextBox2.Value = 7 Then A = Array(15, 17, 19)
If TextBox2.Value = 8 Then A = Array(17, 19, 21)
If TextBox2.Value = 9 Then A = Array(19, 21, 23)
If TextBox2.Value = 10 Then A = Array(21, 23, 25)
If TextBox2.Value = 11 Then A = Array(23, 25)
If TextBox2.Value = 12 Then A = Array(25)
If TextBox2.Value = "" Then A = Array(3, 5, 7, 15, 17, 19)
新增資料夾.rar (109.11 KB)
收藏 分享

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
25#
發表於 2020-7-12 21:00 | 只看該作者
問題解決了  謝謝準提大大的檔案 還有  n7822123大大的 提點
後來想到的方式  是利用  False 跟 True  的 Boolean 變數  然後再把 輪班的顏色次數先存到 儲存格
再延用 就可以了 XD
  1.                 If Y <= Cells(6, 11) Then
  2.                
  3.                     Select Case DateDiff("d", DateValue(d & "/1/1"), Cells(K, 1)) Mod Cells(5, 11) + 1
  4.                     Case 1 To Cells(3, 11)
  5.                     
  6.                     If Cells(1, 10) <> Year(Date) Then sss = True
  7.                     
  8.                     If yyy <> 0 And yyy <> Cells(3, 11) And sss = True Then
  9.                     
  10.                         Cells(U + 1, W) = "夜班"
  11.                         Cells(U + 1, W).Font.Color = RGB(114, 0, 55)
  12.                         Cells(U + 1, W).Interior.Color = RGB(255, 208, 0)
  13.                         
  14.                         If Cells(U + 1, W) <> "休假" And Cells(U + 1, W) <> "上班" Then yyy = yyy + 1
  15.                         Cells(1, 13) = yyy '儲存延伸天數
  16.                         
  17.                         If yyy = Cells(3, 11) Then
  18.                            yyy = 0
  19.                            sss = False
  20.                         End If
  21.                         
  22.                     Else
  23.                         Cells(U + 1, W) = "上班"
  24.                         Cells(U + 1, W).Font.Color = RGB(0, 0, 89)
  25.                         Cells(U + 1, W).Interior.Color = RGB(150, 201, 123)
  26.                     End If
  27.                     
  28.                         If Cells(U + 1, W) <> "休假" And Cells(U + 1, W) <> "夜班" Then kkk = kkk + 1
  29.                         Cells(1, 12) = kkk '儲存延伸天數
  30.                         If kkk = Cells(3, 11) Then kkk = 0
  31.                         
  32.                     End Select
  33.                     
  34.                 ElseIf Y <= Cells(6, 11) * 2 Then
  35.                
  36.                     Select Case DateDiff("d", DateValue(d & "/1/1"), Cells(K, 1)) Mod Cells(5, 11) + 1
  37.                     Case 1 To Cells(3, 11)
  38.                     
  39.                     If Cells(1, 10) <> Year(Date) Then sss = True
  40.                     
  41.                     If kkk <> 0 And kkk <> Cells(3, 11) And sss = True Then
  42.                         
  43.                         Cells(U + 1, W) = "上班"
  44.                         Cells(U + 1, W).Font.Color = RGB(0, 0, 89)
  45.                         Cells(U + 1, W).Interior.Color = RGB(150, 201, 123)
  46.                         
  47.                         If Cells(U + 1, W) <> "休假" And Cells(U + 1, W) <> "夜班" Then kkk = kkk + 1
  48.                         Cells(1, 12) = kkk '儲存延伸天數

  50.                         If kkk = Cells(3, 11) Then
  51.                            kkk = 0
  52.                            sss = False
  53.                         End If
  54.                         
  55.                     Else
  56.                         Cells(U + 1, W) = "夜班"
  57.                         Cells(U + 1, W).Font.Color = RGB(114, 0, 55)
  58.                         Cells(U + 1, W).Interior.Color = RGB(255, 208, 0)
  59.                     End If
  60.                     
  61.                         If Cells(U + 1, W) <> "休假" And Cells(U + 1, W) <> "上班" Then yyy = yyy + 1
  62.                         Cells(1, 13) = yyy '儲存延伸天數
  63.                         If yyy = Cells(3, 11) Then yyy = 0
  64.                            
  65.                     End Select
  66.                     
  67.                 End If
複製代碼
謝謝大大們的指導

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
24#
發表於 2020-7-11 20:01 | 只看該作者
本帖最後由 軒云熊 於 2020-7-11 20:05 編輯

請問 有關於月輪班  跨月的部分問題
當一個月 的最後一輪 到 下個月的第一輪
該用怎麼樣的判斷方式 才可以完整的 把一整輪的天數輪完
而不會因為隔月的問題 導致 錯誤
嘗試了計數的方式 還是不行 會卡到月份問題 有的月份天數不一樣
請前輩們 幫幫忙

改版後的班表練習.rar (20.09 KB)

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
23#
發表於 2020-7-1 05:06 | 只看該作者
謝謝n7822123大大的指點 讓我想到 把 -1 的位置改一下就可以了
DateAdd("d", -1, K) Mod 12 + 1
老實說我真的看不懂  只能F8 慢慢研究XD
準大的版本對我來說好複雜 ...如果有不懂的地方 再請教n7822123大大還有各位前輩們 ^^"

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
22#
發表於 2020-6-30 02:23 | 只看該作者
回復 21# n7822123


哎! 看錯了，這行改一下

TN = Int((i - xDay + 1) / (xVD1 + xVD2))
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
21#
發表於 2020-6-30 00:37 | 只看該作者
本帖最後由 n7822123 於 2020-6-30 00:49 編輯

回復 20# 軒云熊


準提大大的版本 排版更是清楚

準大的版本看起來很舒服，

你已經要放棄你原本很花的格式，想用準大的版本了嗎XD  　

需求：

如果要設定幾輪上　夜班　日班
但我應該在哪一段修改　要怎麼寫？

準大不是用純VBA做的，有搭配定義名稱、函數公式

簡單來說，不能只給你VBA程式~

先開欄位吧~~如下圖




儲存格C8 新增一個選項 "日夜輪流"

假設一樣做4休2，6天為1輪，第1~4輪上日班，第6~10輪上夜班，第11輪又回到日班，以此類推~

你要的功能，只需要修改 "Sub 日曆_排班" 這個程序即可

而且資料的部分更是只需修改AD、AE 兩欄，此程序的後段程式與資料無關，內容大概是

用VBA設公式(抓AD、AE資料)>複製公式>清除公式>設儲存格顏色(依[aRngColor]格式)

也就只是把月曆格式弄出來而已，你有興趣也可以研究一下

準大寫的程式應該可以讓你學到很多~~~前提是你要能看得懂~

根據你的需求，我把我新增的程式用紅色 Hight Light

這樣你可以比較好區分改了哪些，為什麼這樣改~

我的程式是假設 先輪日班 再輪夜班，如果你要顛倒，可以試著改看看~真的不難


Sub 日曆_排班()
Dim D1&, D2&, xDay&, xMon&, xTP$, xVM&, xVD1%, xVD2%
Dim Arr, i&, R&, C&, C2&, N&, TN&, T$, xR As Range
If [A_Head] = [A_End] Then MsgBox "**〔月曆〕尚未建立!   ":  Exit Sub
D1 = [A_Head]: D2 = [A_End] + 30
'---------------------------------
xDay = [aRng1]: If xDay = 0 Then xDay = D1
If xDay < D1 Or xDay > D2 Then MsgBox "〔排班首日〕超出日曆範圍!   ":  Exit Sub
xMon = Format(xDay, "yyyymm")
'---------------------------------
xTP = [aRng2]: If xTP = "" Then MsgBox "〔排班班別〕未輸入!   ": Exit Sub
If xTP = "日夜輪流" Then Turn = True
xVM = [aRng3]: If xVM = 0 Then MsgBox "〔排班月數〕未輸入!   ": Exit Sub
xVD1 = [aRng4]: If xVD1 = 0 Then MsgBox "〔排班天數〕未輸入!   ": Exit Sub
xVD2 = [aRng5]: If xVD2 = 0 Then MsgBox "〔休息天數〕未輸入!   ": Exit Sub
Dturn = [aRng6]: NTurn = [aRng7]
If Turn And (Dturn = "" Or NTurn = "") Then MsgBox "〔日、夜班輪數〕未輸入完全"  : Exit Sub
'---------------------------------
Call 日曆_排班_重置
ReDim Arr(1 To D2 - xDay + 1, 1 To 2)
For i = xDay To D2
    xMon = Format(i, "yyyymm")
    If xMon <> YM Then YM = xMon: N = N + 1
    TN = Int((i - D1 + 1) / (xVD1 + xVD2))
    If N > xVM Then Exit For
    R = R + 1
    C = C Mod (xVD1 + xVD2) + 1
    C2 = TN Mod (Dturn + NTurn) + 1
    T = IIf(Turn, IIf(C2 > Dturn, "夜班", "日班"), xTP)
    If C > xVD1 Then T = "休息"
    Arr(R, 1) = i
    Arr(R, 2) = T
Next i
[AD1] = "＜日期＞": [AE1] = "＜班別＞"
[AD2:AE2].Resize(R) = Arr
...
...
...

練習日期v01-0630.rar (107.3 KB)
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
20#
發表於 2020-6-29 02:28 | 只看該作者
本帖最後由 軒云熊 於 2020-6-29 02:29 編輯

問題解決了 >"< 但是這寫法 並不是很好  
後來想出來的辦法是用 顏色 去做判斷
日期的計算 實在沒辦法...真的想不出來
再把最後的顏色數值先存到儲存格
更改下一年之後 再把顏色數值存回變數...
實在想不出辦法的辦法...  希望有更好的辦法
準提大大的版本 排版更是清楚　
但我應該在哪一段修改　要怎麼寫？

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
19#
發表於 2020-6-28 19:36 | 只看該作者
請問准提大大　如果要設定幾輪上　夜班　日班　假設一輪是１２天
該如何寫呢？
準提大大的版本　排版更是清楚　但我應該在哪一段修改　要怎麼寫？　

以下是之前修改過的　但對我來說已經是極限了．．實在想不出來　＞＂＜
問題出在這裡：
如果用　＂ｗｗ＂　週數計算上班的天數就會有問題．．不知如何修改　
＂ｄ＂天數會搭不到　　
        Select Case DateAdd("d", -1, K) Mod Cells(1, 3) + 1   '常日班
        Case 1 To Cells(1, 4)
            G.Offset = "上班"
            G.Offset.Font.Color = RGB(0, 0, 89)
            G.Interior.Color = RGB(150, 201, 123)
        Case Cells(1, 4) + 1 To Cells(1, 4) + Cells(1, 5)
            If G.Offset >= Cells(1, 1) Then
            G.Offset = "休假"
            G.Offset.Font.Color = RGB(114, 0, 55)
            G.Offset.Interior.Color = RGB(255, 255, 92)
            End If
        End Select
        
        Select Case DateAdd("d", -1, K) Mod Cells(1, 7) + 1 '周輪班
        Case 1 To Cells(1, 4)
            G.Offset = "夜班"
            G.Offset.Font.Color = RGB(114, 0, 55)
            G.Offset.Interior.Color = RGB(255, 208, 0)
        Case Cells(1, 4) + 1 To Cells(1, 4) + Cells(1, 5)
        End Select
　－－－－－－－－－－－－－－－－－－－－－－
  1. Public Sub 周輪班練習()
  2. Range(Cells(2, 1).End(xlToRight), Cells(2, 1).End(xlDown)).Clear
  3. Cells(1, 3) = Cells(1, 4) + Cells(1, 5)
  4. Cells(1, 7) = Cells(1, 3) * 2
  5.    If Cells(1, 2) = "" Then
  6.       Cells(1, 2) = Year(Date)
  7.    Else
  8.       Cells(1, 2) = Cells(1, 2)
  9.    End If

  11.     S = 3
  12.     E = 1
  13.     For F = 1 To 12 '建立範圍
  14.         For P = 1 To Day(DateSerial(Cells(1, 2), F + 1, 0))
  15.             Cells(S, E) = DateSerial(Cells(1, 2), F, P)
  16.             Cells(S - 1, E) = F & "月" & P & "日" & WeekdayName(Weekday(P))
  17.             E = E + 1
  18.             If P = Day(DateSerial(Cells(1, 2), F + 1, 0)) Then
  19.             If F = 12 Then Exit For
  20.                S = S + 2
  21.                E = 1
  22.             End If
  23.         Next P
  24.     Next F
  25.    
  26.     For E = ActiveWorkbook.Names.Count To 1 Step -1 '清除定義名稱
  27.        If ActiveWorkbook.Names(E).Name <> "" Then
  28.           ActiveWorkbook.Names(E).Delete
  29.        End If
  30.     Next E
  31.    
  32.     Y = 65
  33.     For i = 3 To Cells(3, 1).End(xlDown).Row Step 2 '定義名稱
  34.         範圍名稱 = Chr(Y)
  35.         Names.Add Name:="第" & 範圍名稱 & "項", RefersTo:=Range(Cells(i, 1), Cells(i, 1).End(xlToRight))
  36.         Y = Y + 1
  37.     Next i
  38.    
  39.     Set AWN = ActiveWorkbook.Names '合併
  40.     For R = 1 To AWN.Count
  41.        If R <> 1 Then
  42.           K = Mid(AWN(R).RefersToR1C1Local, 2, Len(AWN(R))) & ","
  43.        Else
  44.           K = AWN(R).RefersToR1C1Local & ","
  45.        End If
  46.         U = U + K
  47.     Next R
  48.     Names.Add Name:="指定範圍", RefersTo:=Mid(U, 1, Len(U) - 1)
  49.    
  50.     For E = ActiveWorkbook.Names.Count To 1 Step -1 '清除定義名稱
  51.        If ActiveWorkbook.Names(E).Name <> "指定範圍" Then
  52.           ActiveWorkbook.Names(E).Delete
  53.        End If
  54.     Next E
  55.    
  56.    If Cells(1, 1) = "" Then
  57.       Cells(1, 1) = Cells(3, 1)
  58.    Else
  59.       Cells(1, 1) = Cells(1, 1)
  60.    End If
  61.    
  62.     D = Cells(1, 1)
  63.    
  64.     For Each G In Range("指定範圍") '周輪班
  65.     If G.Offset >= Cells(1, 1) Then
  66.         If Weekday(G) = 1 Or Weekday(G) = 7 Then '六日上色
  67.            G.Offset(-1, 0).Interior.Color = RGB(172, 199, 213)
  68.         End If
  69.    
  70.         K = G.Offset
  71.         
  72.         Select Case DateAdd("d", -1, K) Mod 6 + 1   '常日班
  73.         Case 1 To 4
  74.             G.Offset = "上班"
  75.             G.Offset.Font.Color = RGB(0, 0, 89)
  76.             G.Interior.Color = RGB(150, 201, 123)
  77.         Case 5 To 6
  78.             If G.Offset >= Cells(1, 1) Then
  79.             G.Offset = "休假"
  80.             G.Offset.Font.Color = RGB(114, 0, 55)
  81.             G.Offset.Interior.Color = RGB(255, 255, 92)
  82.             End If
  83.         End Select
  84.         
  85.         Select Case DateAdd("d", -1, K) Mod 12 + 1 '周輪班
  86.         Case 1 To 4
  87.             G.Offset = "夜班"
  88.             G.Offset.Font.Color = RGB(114, 0, 55)
  89.             G.Offset.Interior.Color = RGB(255, 208, 0)
  90.         Case 5 To 6
  91.         End Select
  92.         
  93.     End If
  94.     Next G
  95.    
  96. End Sub
複製代碼

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-21 
18#
發表於 2020-6-28 11:24 | 只看該作者
公式+VBA:
練習日期v01.rar (23.29 KB)

那"排班"--僅以 [上?休?] 來排, 不具實用性, 參考吧!

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
17#
發表於 2020-6-24 15:21 | 只看該作者
子細看了 n7822123 大大的 Sub 玩日期 ()   發現
把外面再包一個 Int     D = Int(G.Offset)    就正常了不用多加迴圈  >"<

TOP

        靜思自在 : 能付出愛心就是福，能消除煩惱就是慧。
123
返回列表 上一主題