Board logo

標題: 100年值日表 [打印本頁]
作者: h60327    時間: 2011-10-28 10:14     標題: 100年值日表

本帖最後由 h60327 於 2011-10-28 12:11 編輯

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

回復 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") '補上班

  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

  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

  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

  35. End Sub
複製代碼
作者: h60327    時間: 2011-10-28 12:10     標題: RE: 100年值日表

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

回復 2# Hsieh


很不錯的值日表，請問超級板主、如果以相同格式，用隔週休排班，該如何更改!
謝謝!!!
作者: Hsieh    時間: 2011-10-28 23:58

  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

  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

  40. End Sub
複製代碼
回復 4# man65boy
作者: man65boy    時間: 2011-10-29 23:35

回復 5# Hsieh

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



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