返回列表 上一主題 發帖

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

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
1# 跳轉到 »
發表於 2020-6-17 01:56 | 顯示全部帖子
本帖最後由 n7822123 於 2020-6-17 02:06 編輯

回復 1# 軒云熊

需求：
請問前輩們 以下這段該如何改寫 才能夠改成動態的規律 如何可以縮減程式碼

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)

同意準大說的，自己寫的程式自己能看懂，才是最好的！
別人寫的很短很厲害，你如果看不懂，之後要改程式也無從下手，會更痛苦
依你的需求，程式改成如下，但執行速度不會比較快~

k = TextBox2.Value: If k = "" Then k = 1
For i = k To 12: Idx = Idx + 1
  If Idx < 4 Or Idx > 6 Then
    itm = itm + 1: If itm = 7 Then Exit For
    s = s & "," & i * 2 + 1
  End If
Next i
A = Split(Mid(s, 2), ",")
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

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

回復 1# 軒云熊


寫法二：
k = TextBox2.Value: If k = "" Then k = 1
For i = k To 12
  s = s & "," & i * 2 + 1
  itm = itm + 1: If itm = 6 Then Exit For
  If i = k + 2 Then i = i + 5
Next i
A = Split(Mid(s, 2), ",")

看你覺得那個你比較好理解
新手不建議在For迴圈裡面改For迴圈的變數值
以免不小心就弄成無窮迴圈，所以不太推薦此寫法
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
3#
發表於 2020-6-17 02:33 | 顯示全部帖子
本帖最後由 n7822123 於 2020-6-17 02:43 編輯

回復 6# n7822123


漏改到，修正寫法二

k = TextBox2.Value: If k = "" Then k = 1
For i = k To 12
  s = s & "," & i * 2 + 1
  itm = itm + 1: If itm = 6 Then Exit For
  If i = k + 2 Then i = i + 3    '跳過後3個迴圈
Next i
A = Split(Mid(s, 2), ",")
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
4#
發表於 2020-6-23 14:09 | 顯示全部帖子
本帖最後由 n7822123 於 2020-6-23 14:13 編輯

回復 10# 軒云熊

聽準大的~~你就讓日期回歸到日期格式，別用文字格式玩

日期格式是可以做計算的，用日期格式計算，算到西元3000年~都沒問題

要發問就要把你的問題 提取出來，做成簡單的Excel檔案，可以做測試就好

大部分人(包含我)看到一大串程式，就懶的去研究了，何況大部分程式跟你提問的不相干

所以我本來是懶得回你的~

我做一個小範例讓你參考吧，你的程式不相干的東西有點多，懶的研究

Sub 玩日期()
Dim Date1 As Date, Date2 As Date
CheckOK = False
Do Until CheckOK
  On Error Resume Next
  Date1 = InputBox("請輸入第一天上班日期，" & vbCrLf & " 需要日期格式 Ex：2020/1/1")
  If Err <> 0 Then MsgBox "你輸入的不是日期格式，請修改" Else CheckOK = True
  On Error GoTo 0
Loop
CheckOK = False
Do Until CheckOK
  On Error Resume Next
  Date2 = InputBox("請輸入要查詢的日期，" & vbCrLf & " 需要日期格式 Ex：2020/7/1")
  If Err <> 0 Then MsgBox "你輸入的不是日期格式，請修改" Else CheckOK = True
  On Error GoTo 0
Loop
Date1 = Date1 - 1
If Date2 - Date1 < 0 Then MsgBox "你輸入的查詢日期比第一天上班日還前面": Exit Sub
'以做4休2為例(6天一循環)
Select Case (Date2 - Date1) Mod 6
    Case 1, 2, 3, 4: MsgBox "這天要上班"
    Case 5, 6: MsgBox "恭喜!這天是休假^.^"
End Select
End Sub
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
5#
發表於 2020-6-24 00:13 | 顯示全部帖子
回復 12# 軒云熊

聽你的回覆，感覺你可以自己完成嘍~

另外我的範例程式有點小錯

Sub 玩日期()
Dim Date1 As Date, Date2 As Date
CheckOK = False
Do Until CheckOK
  On Error Resume Next
  Date1 = InputBox("請輸入第一天上班日期，" & vbCrLf & " 需要日期格式 Ex：2020/1/1")
  If Err <> 0 Then MsgBox "你輸入的不是日期格式，請修改" Else CheckOK = True
  On Error GoTo 0
Loop
CheckOK = False
Do Until CheckOK
  On Error Resume Next
  Date2 = InputBox("請輸入要查詢的日期，" & vbCrLf & " 需要日期格式 Ex：2020/7/1")
  If Err <> 0 Then MsgBox "你輸入的不是日期格式，請修改" Else CheckOK = True
  On Error GoTo 0
Loop
Date1 = Date1 - 1
If Date2 - Date1 < 0 Then MsgBox "你輸入的查詢日期比第一天上班日還前面": Exit Sub
'以做4休2為例(6天一循環)
Select Case Int(Date2 - Date1) Mod 6
    Case 1, 2, 3, 4: MsgBox "這天要上班"
    Case 5, 0: MsgBox "恭喜!這天是休假^.^"
End Select
End Sub  
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
6#
發表於 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

n7822123
　暱稱: 阿龍

中學生Rank: 2

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


哎! 看錯了，這行改一下

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

TOP

        靜思自在 : 能善用時間的人，必能掌握自己努力的方向。
返回列表 上一主題