- 帖子
- 39
- 主題
- 11
- 精華
- 0
- 積分
- 56
- 點名
- 0
- 作業系統
- XP3
- 軟體版本
- OFFICE 2003
- 閱讀權限
- 20
- 註冊時間
- 2010-5-7
- 最後登錄
- 2023-3-22
|
2#
發表於 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
Range([E2], [E65536].End(xlUp)).FormulaR1C1 = _
"=IF(WEEKDAY(RC[-3])=2,""一"",(IF(WEEKDAY(RC[-3])=3,""二"",(IF(WEEKDAY(RC[-3])=4,""三"",(IF(WEEKDAY(RC[-3])=5,""四"",(IF(WEEKDAY(RC[-3])=6,""五"",(IF(WEEKDAY(RC[-3])=7,""六"",(IF(WEEKDAY(RC[-3])=1,""日"","""")))))))))))))"
Range([E2], [E65536].End(xlUp)).Formula = Range([E2], [E65536].End(xlUp)).Value
End Sub
執行至For i = 2 To [M65536].End(xlUp).Row 就發生錯誤 |
-
-
123.rar
(17.11 KB)
|
