返回列表 上一主題 發帖

100年值日表

100年值日表

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

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

回復 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. For i = 2 To [M65536].End(xlUp).Row '國定假日
  8. temp = Month(Cells(i, 13)) & "," & Day(Cells(i, 13))
  9. ds.Add temp, i
  10. Next
  11. For i = 2 To [O65536].End(xlUp).Row '補上班
  12. temp = Month(Cells(i, 15)) & "," & Day(Cells(i, 15))
  13. ds1.Add temp, i
  14. Next

  15. For i = [k1] To DateAdd("yyyy", 1, [k1]) - 1
  16. test = Month(i) & "," & Day(i)
  17.    If (Weekday(i, vbMonday) < 6 And ds.Exists(test) = False) Or ds1.Exists(test) = True Then  '週一至週五並扣除M欄國定假日加入補上班日
  18.      s = s + 1
  19.      Arr(s, 1) = i
  20.      Arr(s, 2) = Month(i)
  21.      Arr(s, 3) = Day(i)
  22.      Arr(s, 4) = Weekday(i, 2)
  23.      k = IIf(s Mod UBound(Men) = 0, UBound(Men), s Mod UBound(Men))
  24.      Arr(s, 0) = Men(k, 1)
  25.     End If
  26. Next
  27. [A2].Resize(s, 5) = Arr

  28. Range([E2], [E65536].End(xlUp)).FormulaR1C1 = _
  29. "=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,""日"","""")))))))))))))"
  30. Range([E2], [E65536].End(xlUp)).Formula = Range([E2], [E65536].End(xlUp)).Value

  31. End Sub
複製代碼
學海無涯_不恥下問

TOP

RE: 100年值日表

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

TOP

回復 2# Hsieh


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

TOP

  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. Range([E2], [E65536].End(xlUp)).FormulaR1C1 = _
  36. "=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,""日"","""")))))))))))))"
  37. Range([E2], [E65536].End(xlUp)).Formula = Range([E2], [E65536].End(xlUp)).Value

  38. End Sub
複製代碼
回復 4# man65boy
學海無涯_不恥下問

TOP

回復 5# Hsieh

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

TOP

        靜思自在 : 做該做的事是智慧,做不該做的事是愚癡。
返回列表 上一主題