- 帖子
- 1425
- 主題
- 40
- 精華
- 0
- 積分
- 1449
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-4-16
|
本帖最後由 Andy2483 於 2022-12-8 10:20 編輯
回復 11# 星空乂羽翼
謝謝前輩再回復
分享厚學(厚臉皮學生)的心得
心得註解的過程再次檢查到很多缺漏!
明年尾行政院發布的2024年行事曆格式如果沒變??應該可以續用
活化腦細胞,考驗自己恆心耐心的最佳選擇 麻辣家族討論版版
謝謝論壇
Option Explicit
Sub 上班日_假日_補班日()
Dim Brr, Sh1, V, xA, xR, Z, P, W
'↑宣告這些變數是通用型變數
Dim i&, n&, T&
'↑宣告這些變數是長整數
Dim X&(4), Ch$, y%, ymd As Date
'↑宣告X是一維陣列(0~4),(Ch)是字串變數,(y)是短整數變數,(ymd)是日期變數
Set W = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
Set P = CreateObject("Scripting.Dictionary")
'↑令W.Z.P各是字典
Set Sh1 = Sheets("Sheet1")
'↑令Sh1 是"Sheet1" 工作表(表一)
Set Brr = Range(Sh1.[A1], Sh1.UsedRange)
'↑令Brr是表一[A1]到 表一有使用儲存格之間 擴展為最小方正範圍的儲存格集
Sh1.[AA:AH].ClearContents
'↑令欄位清除儲存格內容
V = Split(",一,二,三,四,五,六,七,八,九,十,十一,十二", ",")
'↑令V是 雙引號裡的字串以 ","符號分割成的一維字串陣列(PS:第一個是"",索引號是0)
For i = 1 To 12
'↑設順迴圈!i從1到12
Z(V(i) & "月") = i
'↑令V一維陣列的迴圈索引號位置的字串為key,item是迴圈數,倒進字典裡
Next
For Each xR In Brr
'↑設順迴圈!令xR是 Brr儲存格集裡的一格!由左至右/上至下跑
If xR Like "*西元####年*" Then y = Mid(xR, InStr(xR, "西元") + 2, 4)
'↑如果xR的值 裡面的字元組合有包含 "西元" 連接4個數字 再連接"年" ??
'條件成立!令y是 取xR值的 "西元"字元位置+2 開始,取4個字元的值 PS:2023
Ch = xR & xR.Item(, 2) & xR.Item(, 3)
'↑令Ch字串變數是 xR的值連接 右邊格的值,再連接右2格的值
If Z.Exists(Ch) And xR.Item(, 3) <> "" Then
'↑如果以Ch字串變數查察Z字典是有這key,而且xR 右2格的值不是空字元 ??
Set W(Ch) = xR.Item(1, -1).Resize(14, 7)
'↑令令Ch字串變數當key,ITEM是xR儲存格左2儲存格開始,
'擴展縱向向下14列(含自身),橫向7欄(含自身)的儲存格範圍
'PS:item可以是儲存格集!
End If
Next
Z.Add "非周休二日假日", 1
'↑令"非周休二日假日"字串當key,item是數字 1,倒入Z字典裡
Z.Add "周休二日", 3
'↑令"周休二日"字串當key,item是數字 3,倒入Z字典裡
Z.Add "上班日", 5
'↑令"上班日"字串當key,item是數字 5,倒入Z字典裡
Z.Add "補班日", 7
'↑令"補班日"字串當key,item是數字 7,倒入Z字典裡
For Each xR In W.KEYS
'↑設外順迴圈!令xR是 W字典裡keys的一鍵!由前到後跑
For Each xA In W(xR)
'↑設內順迴圈!令xA是 以xR字串查察W字典得到的item儲存格集的一格,
'由左至右/上至下跑
If IsNumeric(xA) And xA <> "" Then
'↑如果用IsNumeric()函數檢查xA儲存格值是數字,而且xA儲存格值不是空字元 ??
ymd = y & "/" & Z(xR) & "/" & xA
'↑令ymd日期變數是 y連接 "/"符號 連接以xR字串查察Z字典得到的item值,
'再連接 "/"符號,繼續接xA儲存格值 字串之後,變成日期
If xA.Interior.ColorIndex <> -4142 Then
'↑如果xA儲存格底色不是 無底色 ??
If Format(ymd, "w") > 1 And Format(ymd, "w") < 7 Then
'↑再如果ymd這日期如果是星期一到星期五之間的日子 ??
P(ymd) = "非周休二日假日"
'↑雙If條件都成立!就以這ymd日期當key,item是 "非周休二日假日"字串,
'倒入P字典
X(1) = X(1) + 1
'↑令X陣列第二個值 +1 PS:(索引號是1)
W(ymd) = X(1)
'↑令以ymd日期當key,item是 X陣列第二個值 PS:X陣列第一個值是 ""
Else
'↑以下 否則 的的陳述
P(ymd) = "周休二日"
'↑令以這ymd日期當key,item是 "周休二日"字串,倒入P字典
X(2) = X(2) + 1
'↑令X陣列第三個值 +1 PS:(索引號是2)
W(ymd) = X(2)
'↑令以ymd日期當key,item是 X陣列第三個值
End If
ElseIf Format(ymd, "w") > 1 And Format(ymd, "w") < 7 Then
'↑如果xA儲存格底色是 無底色! 再確定ymd這日期如果是星期一到星期五之間的日子 ??
P(ymd) = "上班日"
'↑令以這ymd日期當key,item是 "上班日"字串,倒入P字典
X(3) = X(3) + 1
'↑令X陣列第四個值 +1 PS:(索引號是3)
W(ymd) = X(3)
'↑令以ymd日期當key,item是 X陣列第四個值
n = n + 1
'↑令n累加 1 PS:這是要算Brr陣列宣告縱向範圍的數量
Else
'↑如果xA儲存格底色是 無底色! 再確定ymd這日期如果不是星期一到星期五之間的日子 ??
P(ymd) = "補班日"
'↑令以這ymd日期當key,item是 "補班日"字串,倒入P字典
X(4) = X(4) + 1
'↑令X陣列第五個值 +1 PS:(索引號是4)
W(ymd) = X(4)
'↑令以ymd日期當key,item是 X陣列第五個值
End If
End If
Next
Next
For ymd = y & "/1/1" To y & "/12/31"
'↑設日期順迴圈!從年初跑到年尾
If P.Exists(ymd) = Empty Then
'↑如果以迴圈日期查察P字典,是沒有這個鍵 PS:Empty是初始值
MsgBox "缺少: " & ymd
'↑跳出 "缺少: " 連接迴圈日期字串的提示窗
GoTo 111
'↑按了確認後就跳到 111的位置繼續執行 PS:缺日期就不跑了
End If
T = T + 1
'↑令T數字變數累加 1
Next
ReDim Brr(1 To n, 1 To 8)
'↑把原本是儲存格集的Brr變身!宣告成為二維陣列,
'縱向從1到n變數列,橫向從1到8欄
For Each xR In P.KEYS
'↑設順迴圈!令xR是 P字典裡keys的一鍵!由前到後跑
ymd = xR
'↑令ymd日期變數裝xR的值 PS:如果沒記錯的話!P字典應該是裝 年初到年尾的日期鍵,日別item
Brr(W(ymd), Z(P(ymd))) = ymd
'↑令(ymd查察W字典得到的item值)為列號,(ymd查察Z字典得到的item值)為欄號的Brr陣列值是 ymd日期
Brr(W(ymd), Z(P(ymd)) + 1) = Format(ymd, "aaaa")
'↑令右邊鄰居Brr陣列值是國字星期數
Next
Sh1.[AA1].Resize(1, 8) = [{"非周休二日假日","","周休二日","","上班日","","補班日",""}]
'↑令表一[AA1]向下擴展1列(自身列),向右擴展8欄的儲存格,以一維陣列值倒進去
Sh1.[AA2].Resize(n, 8) = Brr
'↑令表一[AA2]向下擴展n列(含自身列),向右擴展8欄的儲存格,以Brr陣列值倒進去
Sh1.[AA:AH].Columns.AutoFit
'↑令表一[AA:AH]欄寬自動調整
Sh1.[AA1].CurrentRegion.Borders.LineStyle = 1
'↑令表一[AA1]儲存格八方相鄰接龍的儲存格擴展的最小方正範圍儲存格,的格線是細實線
MsgBox y & "年 共有 " & T & " 天" & vbLf & _
"非周休二日假日 共: " & X(1) & " 天" & vbLf & _
"周休二日 共: " & X(2) & " 天" & vbLf & _
"上班日 共: " & X(3) & " 天" & vbLf & _
"補班日 共: " & X(4) & " 天"
'↑跳出提示窗!顯示各日別統計天數
111
Set W = Nothing: Set Z = Nothing: Set P = Nothing: Set Brr = Nothing
Erase V, X
End Sub |
|
發表於 2022-12-6 12:07
| 
