麻辣家族討論版版 - Powered by Discuz! Board

標題: EXCEL國定假日自動更新 [打印本頁]

作者: 星空乂羽翼 時間: 2022-12-6 10:51 標題: EXCEL國定假日自動更新

請問各位大前輩
目前小弟有做ㄧ些萬年曆或是專案的檔案
目前國定假日或補班日的日期都是在分頁上用手動的方式打上

請問有沒有什麼方式可以讓每年的國定假日及補班日可以自動抓取資料呢？
我自己想到可能的方式如像股票那樣用網頁抓取資料的方式
但還不確定可行性

再麻煩各位大大幫忙，感謝！

作者: Andy2483 時間: 2022-12-6 12:07

本帖最後由 Andy2483 於 2022-12-6 12:11 編輯

回復 1# 星空乂羽翼

謝謝前輩發表此主題
論壇有對網頁抓取很厲害的前輩!
如果上傳範例檔(萬年曆或是專案的檔案)與告知想要用哪個行事曆網頁網址做更新,
比較有機會有方案可解決

作者: 星空乂羽翼 時間: 2022-12-6 13:23

回復 2# Andy2483
感謝Andy2483前輩回覆
檔案如附件
[attach]35565[/attach]

目前表單是製作萬年歷的樣式
用來記錄每日中餐人員數量
但只要新的ㄧ年就要自己用手動更新補班日及休假日
想依照行政院公告行事曆的補班日及休假日進行更新
不知道是否可行呢？

p.s小弟權限不足，無法貼網址，要麻煩各位大大查一下政院公告行事曆，不好意思

作者: Andy2483 時間: 2022-12-7 11:27

本帖最後由 Andy2483 於 2022-12-7 11:34 編輯

回復 3# 星空乂羽翼
謝謝前輩回復!請試試看
後學藉此題練習陣列與字典,學到很多知識,謝謝
1.下載檔案
行政院人事總處官網:
https://www.dgpa.gov.tw
112年辦公日曆表.xls下載:
https://www.dgpa.gov.tw/FileConversion?filename=dgpa/files/202206/e71dbdb7-5339-48a7-b11e-172b2875df1e.xls&nfix=&name=112%E5%B9%B4%E8%BE%A6%E5%85%AC%E6%97%A5%E6%9B%86%E8%A1%A8.xls

2.將下列程式碼放入VBA作執行

下載檔案,未執行:
[attach]35568[/attach]

執行後:
[attach]35569[/attach]

Option Explicit
Sub 上班日_假日_補班日()
Dim Brr, Sh1, V, xA, xR, Z, P, W, i&, n&, Ch$, y%, ymd As Date
Dim X&(4)
Set W = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
Set P = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("Sheet1")
Set Brr = Range(Sh1.[A1], Sh1.UsedRange)
Sh1.[AA:AH].ClearContents
V = Split(",一,二,三,四,五,六,七,八,九,十,十一,十二", ",")
For i = 1 To 12
Z(V(i) & "月") = i
Next
For Each xR In Brr
If xR Like "*西元####年*" Then y = Mid(xR, InStr(xR, "西元") + 2, 4)
Ch = xR & xR.Item(, 2) & xR.Item(, 3)
If Z.Exists(Ch) And xR.Item(, 3) <> "" Then
   Set W(Ch) = xR.Item(1, -1).Resize(14, 7)
End If
Next
Z.Add "非周休二日假日", 1
Z.Add "周休二日", 3
Z.Add "上班日", 5
Z.Add "補班日", 7
For Each xR In W.KEYS
For Each xA In W(xR)
   If IsNumeric(xA) And xA <> "" Then
      ymd = y & "/" & Z(xR) & "/" & xA
      If xA.Interior.ColorIndex <> -4142 Then
         If Format(ymd, "w") > 1 And Format(ymd, "w") < 7 Then
            P(ymd) = "非周休二日假日"
            X(1) = X(1) + 1
            W(ymd) = X(1)
            Else
               P(ymd) = "周休二日"
               X(2) = X(2) + 1
               W(ymd) = X(2)
         End If
         ElseIf Format(ymd, "w") > 1 And Format(ymd, "w") < 7 Then
            P(ymd) = "上班日"
            X(3) = X(3) + 1
            W(ymd) = X(3)
            n = n + 1
         Else
            P(ymd) = "補班日"
            X(4) = X(4) + 1
            W(ymd) = X(4)
      End If
   End If
Next
Next
ReDim Brr(1 To n, 1 To 8)
For Each xR In P.KEYS
ymd = xR
Brr(W(ymd), Z(P(ymd))) = ymd
Brr(W(ymd), Z(P(ymd)) + 1) = Format(ymd, "aaaa")
Next
[AA1].Resize(1, 8) = [{"非周休二日假日","","周休二日","","上班日","","補班日",""}]
[AA2].Resize(n, 8) = Brr
Sh1.[AA:AH].Columns.AutoFit
[AA1].CurrentRegion.Borders.LineStyle = 1
Set W = Nothing: Set Z = Nothing: Set P = Nothing: Set Brr = Nothing
Erase V, X
End Sub

作者: Andy2483 時間: 2022-12-7 12:47

添加簡單防錯:
[attach]35570[/attach]

Option Explicit
Sub 上班日_假日_補班日()
Dim Brr, Sh1, V, xA, xR, Z, P, W, i&, n&, Ch$, y%, ymd As Date
Dim X&(4), T&
Set W = CreateObject("Scripting.Dictionary")
Set Z = CreateObject("Scripting.Dictionary")
Set P = CreateObject("Scripting.Dictionary")
Set Sh1 = Sheets("Sheet1")
Set Brr = Range(Sh1.[A1], Sh1.UsedRange)
Sh1.[AA:AH].ClearContents
V = Split(",一,二,三,四,五,六,七,八,九,十,十一,十二", ",")
For i = 1 To 12
Z(V(i) & "月") = i
Next
For Each xR In Brr
If xR Like "*西元####年*" Then y = Mid(xR, InStr(xR, "西元") + 2, 4)
Ch = xR & xR.Item(, 2) & xR.Item(, 3)
If Z.Exists(Ch) And xR.Item(, 3) <> "" Then
   Set W(Ch) = xR.Item(1, -1).Resize(14, 7)
End If
Next
Z.Add "非周休二日假日", 1
Z.Add "周休二日", 3
Z.Add "上班日", 5
Z.Add "補班日", 7
For Each xR In W.KEYS
For Each xA In W(xR)
   If IsNumeric(xA) And xA <> "" Then
      ymd = y & "/" & Z(xR) & "/" & xA
      If xA.Interior.ColorIndex <> -4142 Then
         If Format(ymd, "w") > 1 And Format(ymd, "w") < 7 Then
            P(ymd) = "非周休二日假日"
            X(1) = X(1) + 1
            W(ymd) = X(1)
            Else
               P(ymd) = "周休二日"
               X(2) = X(2) + 1
               W(ymd) = X(2)
         End If
         ElseIf Format(ymd, "w") > 1 And Format(ymd, "w") < 7 Then
            P(ymd) = "上班日"
            X(3) = X(3) + 1
            W(ymd) = X(3)
            n = n + 1
         Else
            P(ymd) = "補班日"
            X(4) = X(4) + 1
            W(ymd) = X(4)
      End If
   End If
Next
Next
For ymd = y & "/1/1" To y & "/12/31"
If P.Exists(ymd) = Empty Then
   MsgBox "缺少: " & ymd
   GoTo 111
End If
T = T + 1
Next
ReDim Brr(1 To n, 1 To 8)
For Each xR In P.KEYS
ymd = xR
Brr(W(ymd), Z(P(ymd))) = ymd
Brr(W(ymd), Z(P(ymd)) + 1) = Format(ymd, "aaaa")
Next
[AA1].Resize(1, 8) = [{"非周休二日假日","","周休二日","","上班日","","補班日",""}]
[AA2].Resize(n, 8) = Brr
Sh1.[AA:AH].Columns.AutoFit
[AA1].CurrentRegion.Borders.LineStyle = 1
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-7 13:43

回復 4# Andy2483

感謝Andy2483前輩的回覆
測試完成可以正常使用，謝謝。

另外想請問可以自動抓取網頁檔案嗎?
還是ㄧ定要手動自己下載呢?

作者: 星空乂羽翼 時間: 2022-12-7 13:45

回復 5# Andy2483

感謝Andy2483前輩的回覆
請問此貼文與上一篇
除了增加顯示天數以外
還有新增或修改什麼內容嗎？

作者: Andy2483 時間: 2022-12-7 14:28

回復 6# 星空乂羽翼

謝謝前輩回復
1.前輩要行政院的行事曆!查行政院人事總處官網只查到附件或行事曆圖片!沒查到以網頁文字呈現的行事曆,等看前輩們的其他方案
2.這更新行事曆的作業,一年更新一次,有什麼特別的需要嗎?需要每天都再檢查一次?
3.如果有網頁是以文字表格呈現的行事曆,應該有機會符合前輩的需求
4.後學也想以網頁更新的 VBA 知識

作者: Andy2483 時間: 2022-12-7 14:33

本帖最後由 Andy2483 於 2022-12-7 14:37 編輯

回復 7# 星空乂羽翼

除了增加顯示天數以外,執行的結果沒有不同,簡單檢查資料表因編輯而漏掉的日期
密防難!使用者謹慎為之!

作者: 星空乂羽翼 時間: 2022-12-7 16:35

回復 8# Andy2483

感謝Andy2483前輩的回覆
了解
我主要也是想了解以網頁更新VBA這部分。
還是非常感謝您的解答！

作者: 星空乂羽翼 時間: 2022-12-7 16:38

回復 9# Andy2483

好的，了解。
感謝前輩思想周到！
:D

作者: Andy2483 時間: 2022-12-8 10:18

本帖最後由 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-8 17:14

回復 12# Andy2483

謝謝前輩的詳細解說
讓後學我可以逐一了解
感謝！

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)