100年值日表 已解決, 如何, 值日表

h60327

123.rar (16.06 KB)

下載次數: 22

2011-10-28 10:12

這是100年的值日表，之前已煩請板大修正，但現在發現一個問題，本來值日表中平常日需扣除週休及例假日(M欄)，但因有補上班問題(O欄)，[例如:1/27放假而於2/4補上班]，請問各位板大這要這要如何解決呢？謝謝大家了

Hsieh

回復 1# h60327

1. Private Sub CommandButton1_Click()
   
2. [A2:H65536].ClearContents
   
3. Dim ds As Object, ds1 As Object, Arr(1 To 65536, 0 To 4), Men, i#, test$, k%, temp$, s&
   
4. Men = Range([J2], [J65536].End(xlUp)).Value
   
5. Set ds = CreateObject("Scripting.Dictionary") '國定假日
   
6. Set ds1 = CreateObject("Scripting.Dictionary") '補上班
   
7. 
   
8. For i = 2 To [M65536].End(xlUp).Row '國定假日
   
9. temp = Month(Cells(i, 13)) & "," & Day(Cells(i, 13))
   
10. ds.Add temp, i
    
11. Next
    
12. For i = 2 To [O65536].End(xlUp).Row '補上班
    
13. temp = Month(Cells(i, 15)) & "," & Day(Cells(i, 15))
    
14. ds1.Add temp, i
    
15. Next
    
16. 
    
17. For i = [k1] To DateAdd("yyyy", 1, [k1]) - 1
    
18. test = Month(i) & "," & Day(i)
    
19.    If (Weekday(i, vbMonday) < 6 And ds.Exists(test) = False) Or ds1.Exists(test) = True Then  '週一至週五並扣除M欄國定假日加入補上班日
    
20.      s = s + 1
    
21.      Arr(s, 1) = i
    
22.      Arr(s, 2) = Month(i)
    
23.      Arr(s, 3) = Day(i)
    
24.      Arr(s, 4) = Weekday(i, 2)
    
25.      k = IIf(s Mod UBound(Men) = 0, UBound(Men), s Mod UBound(Men))
    
26.      Arr(s, 0) = Men(k, 1)
    
27.     End If
    
28. Next
    
29. [A2].Resize(s, 5) = Arr
    
30. 
    
31. Range([E2], [E65536].End(xlUp)).FormulaR1C1 = _
    
32. "=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,""日"","""")))))))))))))"
    
33. Range([E2], [E65536].End(xlUp)).Formula = Range([E2], [E65536].End(xlUp)).Value
    
34. 
    
35. End Sub

複製代碼

h60327

原來自己的思路並沒有錯
但因未加上這一段 Set ds1 = CreateObject("Scripting.Dictionary")
造成無法執行
該學習的還是很多，真是感謝版主不吝指導

man65boy

回復 2# Hsieh


很不錯的值日表，請問超級板主、如果以相同格式，用隔週休排班，該如何更改!
謝謝!!!

Hsieh

1. Private Sub CommandButton1_Click()
   
2. [A2:H65536].ClearContents
   
3. Dim ds As Object, ds1 As Object, d As Object, Arr(1 To 65536, 0 To 4), Men, i#, test$, k%, temp$, s&
   
4. Men = Range([J2], [J65536].End(xlUp)).Value
   
5. Set ds = CreateObject("Scripting.Dictionary") '國定假日
   
6. Set ds1 = CreateObject("Scripting.Dictionary") '補上班
   
7. Set d = CreateObject("Scripting.Dictionary") '補上班
   
8. r = [M65535].End(xlUp).Row
   
9. For i = 2 To r '國定假日
   
10. temp = Month(Cells(i, 13)) & "," & Day(Cells(i, 13))
    
11. ds.Add temp, i
    
12. Next
    
13. r = [O65536].End(xlUp).Row
    
14. For i = 2 To r '補上班
    
15. temp = Month(Cells(i, 15)) & "," & Day(Cells(i, 15))
    
16. ds1.Add temp, i
    
17. Next
    
18. r = DateAdd("yyyy", 1, Range("K1")) - 1
    
19. For i = Range("K1") To r
    
20. test = Month(i) & "," & Day(i)
    
21. If Weekday(i, vbMonday) = 6 Then d(Month(i)) = d(Month(i)) + 1
    
22.    If (Weekday(i, vbMonday) <= 6 And ds.Exists(test) = False) Or ds1.Exists(test) = True Then  '週一至週五並扣除M欄國定假日加入補上班日
    
23.      If d(Month(i)) Mod 2 = 0 And Weekday(i, vbMonday) = 6 Then GoTo 10 '偶數週六跳過
    
24.      s = s + 1
    
25.      Arr(s, 1) = i
    
26.      Arr(s, 2) = Month(i)
    
27.      Arr(s, 3) = Day(i)
    
28.      Arr(s, 4) = Weekday(i, 2)
    
29.      k = IIf(s Mod UBound(Men) = 0, UBound(Men), s Mod UBound(Men))
    
30.      Arr(s, 0) = Men(k, 1)
    
31.     End If
    
32. 10
    
33. Next
    
34. [A2].Resize(s, 5) = Arr
    
35. 
    
36. Range([E2], [E65536].End(xlUp)).FormulaR1C1 = _
    
37. "=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,""日"","""")))))))))))))"
    
38. Range([E2], [E65536].End(xlUp)).Formula = Range([E2], [E65536].End(xlUp)).Value
    
39. 
    
40. End Sub

複製代碼

回復 4# man65boy

man65boy

回復 5# Hsieh

太強了，感謝超級版大，給於此題不一樣的條件更改參考，謝謝~~