Office中國(guó)論壇/Access中國(guó)論壇

 找回密碼
 注冊(cè)

QQ登錄

只需一步，快速開(kāi)始

12下一頁(yè)
返回列表 發(fā)新帖
查看: 9555|回復(fù): 15
打印 上一主題 下一主題

[模塊/函數(shù)] 遞歸法：根據(jù)訂單日期，交貨周期，扣除非工作日計(jì)算交貨日期

[復(fù)制鏈接]
跳轉(zhuǎn)到指定樓層
1#
發(fā)表于 2012-6-25 23:53:34 | 只看該作者 回帖獎(jiǎng)勵(lì) |倒序?yàn)g覽 |閱讀模式
本帖最后由 Henry D. Sy 于 2012-6-27 10:19 編輯

這是為網(wǎng)友寫(xiě)的，現(xiàn)在發(fā)上來(lái)，給有需要的朋友參考，
不是很成熟，大家探討提意見(jiàn)啊---------謝謝 layaman_999 提出寶貴建議
增加：
春節(jié)，端午，中秋，元旦，五一，國(guó)慶
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : DeliveryDay
  3. ' DateTime  : 2012-6-25 23:25
  4. ' Author    : Henry D. Sy
  5. ' 參數(shù)      : OrderDate 下單日期
  6. '
  7. '           : intPeriod 交貨周期（以天為單位）
  8. '
  9. '根據(jù)下單日期及交貨周期計(jì)算剔除非工作日（周六，日）以及五一，國(guó)慶，元旦之交貨日期
  10. '按理：交貨日期=下單日期+周期+非工作日天數(shù)，但加上這段額外的天數(shù)中也許又有周六日
  11. '本例的重點(diǎn)就是利用遞歸函數(shù)來(lái)計(jì)算這非工作日中的非工作日.....
  12. '---------------------------------------------------------------------------------------
  13. '
  14. Public Function DeliveryDay(OrderDate As Date, intPeriod As Integer) As Date

  16.     Dim i As Integer          '循環(huán)變量

  18.     Dim NWD As Integer        '保存非工作日天數(shù)(Non_Work_Days)

  20.     Dim myDate As Date        '生產(chǎn)期間每天的日期，用來(lái)判斷是否為NWD

  22.     Dim gDate As Date         '計(jì)算過(guò)程中的臨時(shí)日期值

  24.     Dim lunarDate As Date     '農(nóng)歷日期

  26.     On Error GoTo DeliveryDay_Error

  28.     For i = 1 To intPeriod    '這里i取值從1開(kāi)始，不考慮0，因?yàn)榻訂萎?dāng)日無(wú)需判斷是否工作日
  29.    
  30.         '考慮周六，日
  31.         myDate = DateAdd("d", i, OrderDate)
  32.         If Weekday(myDate) = 1 Or Weekday(myDate) = 7 Then
  33.             NWD = NWD + 1
  34.         End If

  36.         '下面考慮五一，國(guó)慶，元旦
  37.         If Format(myDate, "mmdd") = "0501" Or _
  38.            Format(myDate, "mmdd") = "0101" Then
  39.             NWD = NWD + 1
  40.         ElseIf Format(myDate, "mmdd") = "1001" Then
  41.             NWD = NWD + 3
  42.         End If

  44.         '考慮春節(jié)，端午，中秋
  45.         lunarDate = GetNlDate(myDate)
  46.         Select Case Format(lunarDate, "mmdd")
  47.         Case "0101"
  48.             NWD = NWD + 3
  49.         Case "0505", "0815"
  50.             NWD = NWD + 1
  51.         End Select

  53.     Next
  54.     '判斷及計(jì)算工作日結(jié)束

  56.     gDate = DateAdd("d", intPeriod, OrderDate)  '在不考慮工作日時(shí)：交貨日期=下單日期+周期
  57.     '下面開(kāi)始考慮工作日
  58.     If NWD = 0 Then   '沒(méi)有非工作日

  60.         DeliveryDay = gDate           '交貨日期=下單日期+周期

  62.         '有非工作日
  63.     Else
  64.         DeliveryDay = DeliveryDay(gDate, NWD)    '為了計(jì)算加上非工作日天數(shù)后的非工作日，這里函數(shù)引用自己本身（遞歸），繼續(xù)循環(huán)計(jì)算至NWD=0
  65.     End If

  67.     On Error GoTo 0
  68.     Exit Function

  70. DeliveryDay_Error:

  72.     MsgBox "Error " & Err.Number & " (" & Err.Description & ") "
  73. End Function
  74. Function GetNlDate(D As Date) As Date
  75.     Dim MonthAdd(11), NongliData(99)
  76.     Dim curYear, curMonth, curDay
  77.     Dim NongliStr
  78.     Dim i, m, n, k, isEnd, bit, TheDate
  79.     '公歷每月前面的天數(shù)
  80.     MonthAdd(0) = 0
  81.     MonthAdd(1) = 31
  82.     MonthAdd(2) = 59
  83.     MonthAdd(3) = 90
  84.     MonthAdd(4) = 120
  85.     MonthAdd(5) = 151
  86.     MonthAdd(6) = 181
  87.     MonthAdd(7) = 212
  88.     MonthAdd(8) = 243
  89.     MonthAdd(9) = 273
  90.     MonthAdd(10) = 304
  91.     MonthAdd(11) = 334
  92.     '農(nóng)歷數(shù)據(jù)
  93.     NongliData(0) = 2635
  94.     NongliData(1) = 333387
  95.     NongliData(2) = 1701
  96.     NongliData(3) = 1748
  97.     NongliData(4) = 267701
  98.     NongliData(5) = 694
  99.     NongliData(6) = 2391
  100.     NongliData(7) = 133423
  101.     NongliData(8) = 1175
  102.     NongliData(9) = 396438
  103.     NongliData(10) = 3402
  104.     NongliData(11) = 3749
  105.     NongliData(12) = 331177
  106.     NongliData(13) = 1453
  107.     NongliData(14) = 694
  108.     NongliData(15) = 201326
  109.     NongliData(16) = 2350
  110.     NongliData(17) = 465197
  111.     NongliData(18) = 3221
  112.     NongliData(19) = 3402
  113.     NongliData(20) = 400202
  114.     NongliData(21) = 2901
  115.     NongliData(22) = 1386
  116.     NongliData(23) = 267611
  117.     NongliData(24) = 605
  118.     NongliData(25) = 2349
  119.     NongliData(26) = 137515
  120.     NongliData(27) = 2709
  121.     NongliData(28) = 464533
  122.     NongliData(29) = 1738
  123.     NongliData(30) = 2901
  124.     NongliData(31) = 330421
  125.     NongliData(32) = 1242
  126.     NongliData(33) = 2651
  127.     NongliData(34) = 199255
  128.     NongliData(35) = 1323
  129.     NongliData(36) = 529706
  130.     NongliData(37) = 3733
  131.     NongliData(38) = 1706
  132.     NongliData(39) = 398762
  133.     NongliData(40) = 2741
  134.     NongliData(41) = 1206
  135.     NongliData(42) = 267438
  136.     NongliData(43) = 2647
  137.     NongliData(44) = 1318
  138.     NongliData(45) = 204070
  139.     NongliData(46) = 3477
  140.     NongliData(47) = 461653
  141.     NongliData(48) = 1386
  142.     NongliData(49) = 2413
  143.     NongliData(50) = 330077
  144.     NongliData(51) = 1197
  145.     NongliData(52) = 2637
  146.     NongliData(53) = 268877
  147.     NongliData(54) = 3365
  148.     NongliData(55) = 531109
  149.     NongliData(56) = 2900
  150.     NongliData(57) = 2922
  151.     NongliData(58) = 398042
  152.     NongliData(59) = 2395
  153.     NongliData(60) = 1179
  154.     NongliData(61) = 267415
  155.     NongliData(62) = 2635
  156.     NongliData(63) = 661067
  157.     NongliData(64) = 1701
  158.     NongliData(65) = 1748
  159.     NongliData(66) = 398772
  160.     NongliData(67) = 2742
  161.     NongliData(68) = 2391
  162.     NongliData(69) = 330031
  163.     NongliData(70) = 1175
  164.     NongliData(71) = 1611
  165.     NongliData(72) = 200010
  166.     NongliData(73) = 3749
  167.     NongliData(74) = 527717
  168.     NongliData(75) = 1452
  169.     NongliData(76) = 2742
  170.     NongliData(77) = 332397
  171.     NongliData(78) = 2350
  172.     NongliData(79) = 3222
  173.     NongliData(80) = 268949
  174.     NongliData(81) = 3402
  175.     NongliData(82) = 3493
  176.     NongliData(83) = 133973
  177.     NongliData(84) = 1386
  178.     NongliData(85) = 464219
  179.     NongliData(86) = 605
  180.     NongliData(87) = 2349
  181.     NongliData(88) = 334123
  182.     NongliData(89) = 2709
  183.     NongliData(90) = 2890
  184.     NongliData(91) = 267946
  185.     NongliData(92) = 2773
  186.     NongliData(93) = 592565
  187.     NongliData(94) = 1210
  188.     NongliData(95) = 2651
  189.     NongliData(96) = 395863
  190.     NongliData(97) = 1323
  191.     NongliData(98) = 2707
  192.     NongliData(99) = 265877
  193.     '生成當(dāng)前公歷年、月、日   ==>   GongliStr
  194.     curYear = Year(D)
  195.     curMonth = Month(D)
  196.     curDay = Day(D)

  198.     '計(jì)算到初始時(shí)間1921年2月8日的天數(shù)：1921-2-8(正月初一)
  199.     TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38
  200.     If ((curYear Mod 4) = 0 And curMonth > 2) Then
  201.         TheDate = TheDate + 1
  202.     End If
  203.     '計(jì)算農(nóng)歷天干、地支、月、日
  204.     isEnd = 0
  205.     m = 0
  206.     Do
  207.         If (NongliData(m) < 4095) Then
  208.             k = 11
  209.         Else
  210.             k = 12
  211.         End If
  212.         n = k
  213.         Do
  214.             If (n < 0) Then
  215.                 Exit Do
  216.             End If
  217.             '獲取NongliData(m)的第n個(gè)二進(jìn)制位的值
  218.             bit = NongliData(m)
  219.             For i = 1 To n Step 1
  220.                 bit = Int(bit / 2)
  221.             Next
  222.             bit = bit Mod 2
  223.             If (TheDate <= 29 + bit) Then
  224.                 isEnd = 1
  225.                 Exit Do
  226.             End If
  227.             TheDate = TheDate - 29 - bit
  228.             n = n - 1
  229.         Loop
  230.         If (isEnd = 1) Then
  231.             Exit Do
  232.         End If
  233.         m = m + 1
  234.     Loop
  235.     curYear = 1921 + m
  236.     curMonth = k - n + 1
  237.     curDay = TheDate
  238.     If (k = 12) Then
  239.         If (curMonth = (Int(NongliData(m) / 65536) + 1)) Then
  240.             curMonth = 1 - curMonth
  241.         ElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) Then
  242.             curMonth = curMonth - 1
  243.         End If
  244.     End If
  245.     '生成農(nóng)歷==>   NongliStr
  246.     GetNlDate = CDate(curYear & "- " & Format(curMonth, "00 ") & "- " & Format(curDay, "00 "))
  247. End Function

復(fù)制代碼

本帖子中包含更多資源

您需要 登錄 才可以下載或查看，沒(méi)有帳號(hào)？注冊(cè)

x
分享到:  QQ好友和群QQ好友和群 QQ空間QQ空間 騰訊微博騰訊微博 騰訊朋友騰訊朋友
收藏收藏2 分享分享 分享淘帖 訂閱訂閱
2#
發(fā)表于 2012-6-26 08:07:25 | 只看該作者
{:soso_e181:}Henry D. Sy 老師謝謝分享您的勞動(dòng)成果�。�
3#
發(fā)表于 2012-6-26 08:28:42 | 只看該作者
學(xué)習(xí)版主大作！
4#
發(fā)表于 2012-6-26 08:31:19 | 只看該作者
謝謝6D
5#
發(fā)表于 2012-6-26 08:43:58 | 只看該作者
學(xué)習(xí)
收下
6#
發(fā)表于 2012-6-26 08:48:07 | 只看該作者
Function JHRQ(ByVal ddrq As Date, ByVal sczq As Long) As Date

'參數(shù)說(shuō)明:ddrq訂單日期，sczq生產(chǎn)周期
'函數(shù)功能：訂單日期(不計(jì)周日六)+生產(chǎn)周期(不計(jì)周日六),計(jì)算出發(fā)貨日期
'layaman_999
'容易誤解的:
'1.周六\日確定的訂單，順延確定日期為周一(例如周六的訂單，生產(chǎn)周期1天的話，應(yīng)該是下周二交貨）
'2.發(fā)貨日期如遇上周六\日,，發(fā)貨確定日期為周一(例如周五的訂單，生產(chǎn)周期1天的話，應(yīng)該是下周一交貨）

Dim i As Long
Dim j As Long
Dim K As Integer

j = 0

For i = 1 To sczq
K = Weekday(ddrq + j)
Select Case K
   Case 1 '星期日
    j = j + 1
   Case 7 '星期六
    j = j + 2
End Select
  j = j + 1
Next i

JHRQ = ddrq + j

K = Weekday(JHRQ)
Select Case K
   Case 1 '星期日
    JHRQ = JHRQ + 1
   Case 7 '星期六
    JHRQ = JHRQ + 2
End Select

End Function
'這個(gè)是我寫(xiě)的一個(gè)，不知是否可行？
7#
發(fā)表于 2012-6-26 09:03:06 | 只看該作者
謝謝分享！
8#
 樓主| 發(fā)表于 2012-6-26 17:14:41 | 只看該作者
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : DeliveryDay
  3. ' DateTime  : 2012-6-25 23:25
  4. ' Author    : Henry D. Sy
  5. ' 參數(shù)      : OrderDate 下單日期
  6. '
  7. '           : intPeriod 交貨周期（以天為單位）
  8. '
  9. '根據(jù)下單日期及交貨周期計(jì)算剔除非工作日（周六，日）以及五一，國(guó)慶，元旦之交貨日期
  10. '按理：交貨日期=下單日期+周期+非工作日天數(shù)，但加上這段額外的天數(shù)中也許又有周六日
  11. '本例的重點(diǎn)就是利用遞歸函數(shù)來(lái)計(jì)算這非工作日中的非工作日.....
  12. '---------------------------------------------------------------------------------------
  13. '
  14. Public Function DeliveryDay(OrderDate As Date, intPeriod As Integer) As Date

  16.     Dim i As Integer          '循環(huán)變量

  18.     Dim NWD As Integer        '保存非工作日天數(shù)(Non_Work_Days)

  20.     Dim myDate As Date        '生產(chǎn)期間每天的日期，用來(lái)判斷是否為NWD

  22.     Dim gDate As Date         '計(jì)算過(guò)程中的臨時(shí)日期值

  24.     On Error GoTo DeliveryDay_Error

  26.     For i = 1 To intPeriod    '這里i取值從1開(kāi)始，不考慮0，因?yàn)榻訂萎?dāng)日無(wú)需判斷是否工作日

  28.         myDate = DateAdd("d", i, OrderDate)
  29.         If Weekday(myDate) = 1 Or Weekday(myDate) = 7 Then
  30.             NWD = NWD + 1
  31.         End If
  32.         '下面考慮五一，國(guó)慶，元旦
  33.         If Right(Format(myDate, "yyyymmdd"), 4) = "0501" Or _
  34.            Right(Format(myDate, "yyyymmdd"), 4) = "0101" Then
  35.             NWD = NWD + 1
  36.         ElseIf Right(Format(myDate, "yyyymmdd"), 4) = "1001" Then
  37.             NWD = NWD + 3
  38.         End If
  39.     Next
  40.     '判斷及計(jì)算工作日結(jié)束

  42.     gDate = DateAdd("d", intPeriod, OrderDate)  '在不考慮工作日時(shí)：交貨日期=下單日期+周期
  43.     '下面開(kāi)始考慮工作日
  44.     If NWD = 0 Then   '沒(méi)有非工作日

  46.         DeliveryDay = gDate           '交貨日期=下單日期+周期

  48.         '有非工作日
  49.     Else
  50.         DeliveryDay = DeliveryDay(gDate, NWD)    '為了計(jì)算加上非工作日天數(shù)后的非工作日，這里函數(shù)引用自己本身（遞歸），繼續(xù)循環(huán)計(jì)算至NWD=0
  51.     End If

  53.     On Error GoTo 0
  54.     Exit Function

  56. DeliveryDay_Error:

  58.     MsgBox "Error " & Err.Number & " (" & Err.Description & ") "
  59. End Function
復(fù)制代碼
現(xiàn)在增加考慮五一，元旦，國(guó)慶
請(qǐng)兄弟們一起來(lái)增加春節(jié)，端午，中秋
9#
 樓主| 發(fā)表于 2012-6-27 10:20:14 | 只看該作者
增加
農(nóng)歷節(jié)日

點(diǎn)擊這里給我發(fā)消息
10#
發(fā)表于 2012-6-27 12:43:19 | 只看該作者
謝謝6D分享！
您需要登錄后才可以回帖 登錄 | 注冊(cè)

本版積分規(guī)則

QQ|站長(zhǎng)郵箱|小黑屋|手機(jī)版|Office中國(guó)/Access中國(guó) ( 粵ICP備10043721號(hào)-1 )  

GMT+8, 2025-7-16 18:19 , Processed in 0.117505 second(s), 34 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回復(fù) 返回頂部 返回列表