Private Sub CommandButton1_Click()
[A2:H65536].ClearContents
Dim ds As Object, ds1 As Object, Arr(1 To 65536, 0 To 4), Men, i#, test$, k%, temp$, s&
%0作者: h60327 時間: 2014-10-29 23:15
Private Sub CommandButton1_Click()
[A2:H65536].ClearContents
Dim ds As Object, ds1 As Object, Arr(1 To 65536, 0 To 4), Men, i#, test$, k%, temp$, s&
Men = Range([J2], [J65536].End(xlUp)).Value
Set ds = CreateObject("Scripting.Dictionary") '國定假日
Set ds1 = CreateObject("Scripting.Dictionary") '補上班
For i = 2 To [M65536].End(xlUp).Row '國定假日
temp = Month(Cells(i, 13)) & "," & Day(Cells(i, 13))
ds.Add temp, i
Next
For i = 2 To [O65536].End(xlUp).Row '補上班
temp = Month(Cells(i, 15)) & "," & Day(Cells(i, 15))
ds1.Add temp, i
Next
For i = [k1] To DateAdd("yyyy", 1, [k1]) - 1
test = Month(i) & "," & Day(i)
If (Weekday(i, vbMonday) < 6 And ds.Exists(test) = False) Or ds1.Exists(test) = True Then '週一至週五並扣除M欄國定假日加入補上班日
s = s + 1
Arr(s, 1) = i
Arr(s, 2) = Month(i)
Arr(s, 3) = Day(i)
Arr(s, 4) = Weekday(i, 2)
k = IIf(s Mod UBound(Men) = 0, UBound(Men), s Mod UBound(Men))
Arr(s, 0) = Men(k, 1)
End If
Next
[A2].Resize(s, 5) = Arr
