- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 253
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-11-22
              
|
5#
發表於 2011-10-28 23:58
| 只看該作者
- Private Sub CommandButton1_Click()
- [A2:H65536].ClearContents
- Dim ds As Object, ds1 As Object, d 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") '補上班
- Set d = CreateObject("Scripting.Dictionary") '補上班
- r = [M65535].End(xlUp).Row
- For i = 2 To r '國定假日
- temp = Month(Cells(i, 13)) & "," & Day(Cells(i, 13))
- ds.Add temp, i
- Next
- r = [O65536].End(xlUp).Row
- For i = 2 To r '補上班
- temp = Month(Cells(i, 15)) & "," & Day(Cells(i, 15))
- ds1.Add temp, i
- Next
- r = DateAdd("yyyy", 1, Range("K1")) - 1
- For i = Range("K1") To r
- test = Month(i) & "," & Day(i)
- If Weekday(i, vbMonday) = 6 Then d(Month(i)) = d(Month(i)) + 1
- If (Weekday(i, vbMonday) <= 6 And ds.Exists(test) = False) Or ds1.Exists(test) = True Then '週一至週五並扣除M欄國定假日加入補上班日
- If d(Month(i)) Mod 2 = 0 And Weekday(i, vbMonday) = 6 Then GoTo 10 '偶數週六跳過
- 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
- 10
- 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
|
|
發表於 2011-10-28 10:14
| 
