设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

12下一页
返回列表 发新帖
查看: 7953|回复: 15
打印 上一主题 下一主题

[模块/函数] 递归法:根据订单日期,交货周期,扣除非工作日计算交货日期

[复制链接]
跳转到指定楼层
1#
发表于 2012-6-25 23:53:34 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 Henry D. Sy 于 2012-6-27 10:19 编辑

这是为网友写的,现在发上来,给有需要的朋友参考,
不是很成熟,大家探讨提意见啊---------谢谢 layaman_999 提出宝贵建议
增加:
春节,端午,中秋,元旦,五一,国庆
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : DeliveryDay
  3. ' DateTime  : 2012-6-25 23:25
  4. ' Author    : Henry D. Sy
  5. ' 参数      : OrderDate 下单日期
  6. '
  7. '           : intPeriod 交货周期(以天为单位)
  8. '
  9. '根据下单日期及交货周期计算剔除非工作日(周六,日)以及五一,国庆,元旦之交货日期
  10. '按理:交货日期=下单日期+周期+非工作日天数,但加上这段额外的天数中也许又有周六日
  11. '本例的重点就是利用递归函数来计算这非工作日中的非工作日.....
  12. '---------------------------------------------------------------------------------------
  13. '
  14. Public Function DeliveryDay(OrderDate As Date, intPeriod As Integer) As Date

  15.     Dim i As Integer          '循环变量

  16.     Dim NWD As Integer        '保存非工作日天数(Non_Work_Days)

  17.     Dim myDate As Date        '生产期间每天的日期,用来判断是否为NWD

  18.     Dim gDate As Date         '计算过程中的临时日期值

  19.     Dim lunarDate As Date     '农历日期

  20.     On Error GoTo DeliveryDay_Error

  21.     For i = 1 To intPeriod    '这里i取值从1开始,不考虑0,因为接单当日无需判断是否工作日
  22.    
  23.         '考虑周六,日
  24.         myDate = DateAdd("d", i, OrderDate)
  25.         If Weekday(myDate) = 1 Or Weekday(myDate) = 7 Then
  26.             NWD = NWD + 1
  27.         End If

  28.         '下面考虑五一,国庆,元旦
  29.         If Format(myDate, "mmdd") = "0501" Or _
  30.            Format(myDate, "mmdd") = "0101" Then
  31.             NWD = NWD + 1
  32.         ElseIf Format(myDate, "mmdd") = "1001" Then
  33.             NWD = NWD + 3
  34.         End If

  35.         '考虑春节,端午,中秋
  36.         lunarDate = GetNlDate(myDate)
  37.         Select Case Format(lunarDate, "mmdd")
  38.         Case "0101"
  39.             NWD = NWD + 3
  40.         Case "0505", "0815"
  41.             NWD = NWD + 1
  42.         End Select

  43.     Next
  44.     '判断及计算工作日结束

  45.     gDate = DateAdd("d", intPeriod, OrderDate)  '在不考虑工作日时:交货日期=下单日期+周期
  46.     '下面开始考虑工作日
  47.     If NWD = 0 Then   '没有非工作日

  48.         DeliveryDay = gDate           '交货日期=下单日期+周期

  49.         '有非工作日
  50.     Else
  51.         DeliveryDay = DeliveryDay(gDate, NWD)    '为了计算加上非工作日天数后的非工作日,这里函数引用自己本身(递归),继续循环计算至NWD=0
  52.     End If

  53.     On Error GoTo 0
  54.     Exit Function

  55. DeliveryDay_Error:

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

  181.     '计算到初始时间1921年2月8日的天数:1921-2-8(正月初一)
  182.     TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38
  183.     If ((curYear Mod 4) = 0 And curMonth > 2) Then
  184.         TheDate = TheDate + 1
  185.     End If
  186.     '计算农历天干、地支、月、日
  187.     isEnd = 0
  188.     m = 0
  189.     Do
  190.         If (NongliData(m) < 4095) Then
  191.             k = 11
  192.         Else
  193.             k = 12
  194.         End If
  195.         n = k
  196.         Do
  197.             If (n < 0) Then
  198.                 Exit Do
  199.             End If
  200.             '获取NongliData(m)的第n个二进制位的值
  201.             bit = NongliData(m)
  202.             For i = 1 To n Step 1
  203.                 bit = Int(bit / 2)
  204.             Next
  205.             bit = bit Mod 2
  206.             If (TheDate <= 29 + bit) Then
  207.                 isEnd = 1
  208.                 Exit Do
  209.             End If
  210.             TheDate = TheDate - 29 - bit
  211.             n = n - 1
  212.         Loop
  213.         If (isEnd = 1) Then
  214.             Exit Do
  215.         End If
  216.         m = m + 1
  217.     Loop
  218.     curYear = 1921 + m
  219.     curMonth = k - n + 1
  220.     curDay = TheDate
  221.     If (k = 12) Then
  222.         If (curMonth = (Int(NongliData(m) / 65536) + 1)) Then
  223.             curMonth = 1 - curMonth
  224.         ElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) Then
  225.             curMonth = curMonth - 1
  226.         End If
  227.     End If
  228.     '生成农历==>   NongliStr
  229.     GetNlDate = CDate(curYear & "- " & Format(curMonth, "00 ") & "- " & Format(curDay, "00 "))
  230. End Function

复制代码

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏2 分享分享 分享淘帖 订阅订阅
2#
发表于 2012-6-26 08:07:25 | 只看该作者
{:soso_e181:}Henry D. Sy 老师谢谢分享您的劳动成果!!
3#
发表于 2012-6-26 08:28:42 | 只看该作者
学习版主大作!
4#
发表于 2012-6-26 08:31:19 | 只看该作者
谢谢6D
5#
发表于 2012-6-26 08:43:58 | 只看该作者
学习
收下
6#
发表于 2012-6-26 08:48:07 | 只看该作者
Function JHRQ(ByVal ddrq As Date, ByVal sczq As Long) As Date

'参数说明:ddrq订单日期,sczq生产周期
'函数功能:订单日期(不计周日六)+生产周期(不计周日六),计算出发货日期
'layaman_999
'容易误解的:
'1.周六\日确定的订单,顺延确定日期为周一(例如周六的订单,生产周期1天的话,应该是下周二交货)
'2.发货日期如遇上周六\日,,发货确定日期为周一(例如周五的订单,生产周期1天的话,应该是下周一交货)

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
'这个是我写的一个,不知是否可行?
7#
发表于 2012-6-26 09:03:06 | 只看该作者
谢谢分享!
8#
 楼主| 发表于 2012-6-26 17:14:41 | 只看该作者
  1. '---------------------------------------------------------------------------------------
  2. ' Procedure : DeliveryDay
  3. ' DateTime  : 2012-6-25 23:25
  4. ' Author    : Henry D. Sy
  5. ' 参数      : OrderDate 下单日期
  6. '
  7. '           : intPeriod 交货周期(以天为单位)
  8. '
  9. '根据下单日期及交货周期计算剔除非工作日(周六,日)以及五一,国庆,元旦之交货日期
  10. '按理:交货日期=下单日期+周期+非工作日天数,但加上这段额外的天数中也许又有周六日
  11. '本例的重点就是利用递归函数来计算这非工作日中的非工作日.....
  12. '---------------------------------------------------------------------------------------
  13. '
  14. Public Function DeliveryDay(OrderDate As Date, intPeriod As Integer) As Date

  15.     Dim i As Integer          '循环变量

  16.     Dim NWD As Integer        '保存非工作日天数(Non_Work_Days)

  17.     Dim myDate As Date        '生产期间每天的日期,用来判断是否为NWD

  18.     Dim gDate As Date         '计算过程中的临时日期值

  19.     On Error GoTo DeliveryDay_Error

  20.     For i = 1 To intPeriod    '这里i取值从1开始,不考虑0,因为接单当日无需判断是否工作日

  21.         myDate = DateAdd("d", i, OrderDate)
  22.         If Weekday(myDate) = 1 Or Weekday(myDate) = 7 Then
  23.             NWD = NWD + 1
  24.         End If
  25.         '下面考虑五一,国庆,元旦
  26.         If Right(Format(myDate, "yyyymmdd"), 4) = "0501" Or _
  27.            Right(Format(myDate, "yyyymmdd"), 4) = "0101" Then
  28.             NWD = NWD + 1
  29.         ElseIf Right(Format(myDate, "yyyymmdd"), 4) = "1001" Then
  30.             NWD = NWD + 3
  31.         End If
  32.     Next
  33.     '判断及计算工作日结束

  34.     gDate = DateAdd("d", intPeriod, OrderDate)  '在不考虑工作日时:交货日期=下单日期+周期
  35.     '下面开始考虑工作日
  36.     If NWD = 0 Then   '没有非工作日

  37.         DeliveryDay = gDate           '交货日期=下单日期+周期

  38.         '有非工作日
  39.     Else
  40.         DeliveryDay = DeliveryDay(gDate, NWD)    '为了计算加上非工作日天数后的非工作日,这里函数引用自己本身(递归),继续循环计算至NWD=0
  41.     End If

  42.     On Error GoTo 0
  43.     Exit Function

  44. DeliveryDay_Error:

  45.     MsgBox "Error " & Err.Number & " (" & Err.Description & ") "
  46. End Function
复制代码
现在增加考虑五一,元旦,国庆
请兄弟们一起来增加春节,端午,中秋
9#
 楼主| 发表于 2012-6-27 10:20:14 | 只看该作者
增加
农历节日

点击这里给我发消息

10#
发表于 2012-6-27 12:43:19 | 只看该作者
谢谢6D分享!
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-1 07:14 , Processed in 0.147370 second(s), 35 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表