递归法：根据订单日期，交货周期，扣除非工作日计算交货日期

Henry D. Sy · 发表于 2012-6-25 23:53:34

本帖最后由 Henry D. Sy 于 2012-6-27 10:19 编辑

这是为网友写的，现在发上来，给有需要的朋友参考，
不是很成熟，大家探讨提意见啊---------谢谢 layaman_999 提出宝贵建议
增加：
春节，端午，中秋，元旦，五一，国庆

'---------------------------------------------------------------------------------------
' Procedure : DeliveryDay
' DateTime : 2012-6-25 23:25
' Author : Henry D. Sy
' 参数 : OrderDate 下单日期
'
' : intPeriod 交货周期（以天为单位）
'
'根据下单日期及交货周期计算剔除非工作日（周六，日）以及五一，国庆，元旦之交货日期
'按理：交货日期=下单日期+周期+非工作日天数，但加上这段额外的天数中也许又有周六日
'本例的重点就是利用递归函数来计算这非工作日中的非工作日.....
'---------------------------------------------------------------------------------------
'
Public Function DeliveryDay(OrderDate As Date, intPeriod As Integer) As Date
Dim i As Integer '循环变量
Dim NWD As Integer '保存非工作日天数(Non_Work_Days)
Dim myDate As Date '生产期间每天的日期，用来判断是否为NWD
Dim gDate As Date '计算过程中的临时日期值
Dim lunarDate As Date '农历日期
On Error GoTo DeliveryDay_Error
For i = 1 To intPeriod '这里i取值从1开始，不考虑0，因为接单当日无需判断是否工作日
'考虑周六，日
myDate = DateAdd("d", i, OrderDate)
If Weekday(myDate) = 1 Or Weekday(myDate) = 7 Then
NWD = NWD + 1
End If
'下面考虑五一，国庆，元旦
If Format(myDate, "mmdd") = "0501" Or _
Format(myDate, "mmdd") = "0101" Then
NWD = NWD + 1
ElseIf Format(myDate, "mmdd") = "1001" Then
NWD = NWD + 3
End If
'考虑春节，端午，中秋
lunarDate = GetNlDate(myDate)
Select Case Format(lunarDate, "mmdd")
Case "0101"
NWD = NWD + 3
Case "0505", "0815"
NWD = NWD + 1
End Select
Next
'判断及计算工作日结束
gDate = DateAdd("d", intPeriod, OrderDate) '在不考虑工作日时：交货日期=下单日期+周期
'下面开始考虑工作日
If NWD = 0 Then '没有非工作日
DeliveryDay = gDate '交货日期=下单日期+周期
'有非工作日
Else
DeliveryDay = DeliveryDay(gDate, NWD) '为了计算加上非工作日天数后的非工作日，这里函数引用自己本身（递归），继续循环计算至NWD=0
End If
On Error GoTo 0
Exit Function
DeliveryDay_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") "
End Function
Function GetNlDate(D As Date) As Date
Dim MonthAdd(11), NongliData(99)
Dim curYear, curMonth, curDay
Dim NongliStr
Dim i, m, n, k, isEnd, bit, TheDate
'公历每月前面的天数
MonthAdd(0) = 0
MonthAdd(1) = 31
MonthAdd(2) = 59
MonthAdd(3) = 90
MonthAdd(4) = 120
MonthAdd(5) = 151
MonthAdd(6) = 181
MonthAdd(7) = 212
MonthAdd(8) = 243
MonthAdd(9) = 273
MonthAdd(10) = 304
MonthAdd(11) = 334
'农历数据
NongliData(0) = 2635
NongliData(1) = 333387
NongliData(2) = 1701
NongliData(3) = 1748
NongliData(4) = 267701
NongliData(5) = 694
NongliData(6) = 2391
NongliData(7) = 133423
NongliData(8) = 1175
NongliData(9) = 396438
NongliData(10) = 3402
NongliData(11) = 3749
NongliData(12) = 331177
NongliData(13) = 1453
NongliData(14) = 694
NongliData(15) = 201326
NongliData(16) = 2350
NongliData(17) = 465197
NongliData(18) = 3221
NongliData(19) = 3402
NongliData(20) = 400202
NongliData(21) = 2901
NongliData(22) = 1386
NongliData(23) = 267611
NongliData(24) = 605
NongliData(25) = 2349
NongliData(26) = 137515
NongliData(27) = 2709
NongliData(28) = 464533
NongliData(29) = 1738
NongliData(30) = 2901
NongliData(31) = 330421
NongliData(32) = 1242
NongliData(33) = 2651
NongliData(34) = 199255
NongliData(35) = 1323
NongliData(36) = 529706
NongliData(37) = 3733
NongliData(38) = 1706
NongliData(39) = 398762
NongliData(40) = 2741
NongliData(41) = 1206
NongliData(42) = 267438
NongliData(43) = 2647
NongliData(44) = 1318
NongliData(45) = 204070
NongliData(46) = 3477
NongliData(47) = 461653
NongliData(48) = 1386
NongliData(49) = 2413
NongliData(50) = 330077
NongliData(51) = 1197
NongliData(52) = 2637
NongliData(53) = 268877
NongliData(54) = 3365
NongliData(55) = 531109
NongliData(56) = 2900
NongliData(57) = 2922
NongliData(58) = 398042
NongliData(59) = 2395
NongliData(60) = 1179
NongliData(61) = 267415
NongliData(62) = 2635
NongliData(63) = 661067
NongliData(64) = 1701
NongliData(65) = 1748
NongliData(66) = 398772
NongliData(67) = 2742
NongliData(68) = 2391
NongliData(69) = 330031
NongliData(70) = 1175
NongliData(71) = 1611
NongliData(72) = 200010
NongliData(73) = 3749
NongliData(74) = 527717
NongliData(75) = 1452
NongliData(76) = 2742
NongliData(77) = 332397
NongliData(78) = 2350
NongliData(79) = 3222
NongliData(80) = 268949
NongliData(81) = 3402
NongliData(82) = 3493
NongliData(83) = 133973
NongliData(84) = 1386
NongliData(85) = 464219
NongliData(86) = 605
NongliData(87) = 2349
NongliData(88) = 334123
NongliData(89) = 2709
NongliData(90) = 2890
NongliData(91) = 267946
NongliData(92) = 2773
NongliData(93) = 592565
NongliData(94) = 1210
NongliData(95) = 2651
NongliData(96) = 395863
NongliData(97) = 1323
NongliData(98) = 2707
NongliData(99) = 265877
'生成当前公历年、月、日 ==> GongliStr
curYear = Year(D)
curMonth = Month(D)
curDay = Day(D)
'计算到初始时间1921年2月8日的天数：1921-2-8(正月初一)
TheDate = (curYear - 1921) * 365 + Int((curYear - 1921) / 4) + curDay + MonthAdd(curMonth - 1) - 38
If ((curYear Mod 4) = 0 And curMonth > 2) Then
TheDate = TheDate + 1
End If
'计算农历天干、地支、月、日
isEnd = 0
m = 0
Do
If (NongliData(m) < 4095) Then
k = 11
Else
k = 12
End If
n = k
Do
If (n < 0) Then
Exit Do
End If
'获取NongliData(m)的第n个二进制位的值
bit = NongliData(m)
For i = 1 To n Step 1
bit = Int(bit / 2)
Next
bit = bit Mod 2
If (TheDate <= 29 + bit) Then
isEnd = 1
Exit Do
End If
TheDate = TheDate - 29 - bit
n = n - 1
Loop
If (isEnd = 1) Then
Exit Do
End If
m = m + 1
Loop
curYear = 1921 + m
curMonth = k - n + 1
curDay = TheDate
If (k = 12) Then
If (curMonth = (Int(NongliData(m) / 65536) + 1)) Then
curMonth = 1 - curMonth
ElseIf (curMonth > (Int(NongliData(m) / 65536) + 1)) Then
curMonth = curMonth - 1
End If
End If
'生成农历==> NongliStr
GetNlDate = CDate(curYear & "- " & Format(curMonth, "00 ") & "- " & Format(curDay, "00 "))
End Function

复制代码

yanwei82123300 · 发表于 2012-6-26 08:07:25

{:soso_e181:}Henry D. Sy 老师谢谢分享您的劳动成果！！

ycxchen · 发表于 2012-6-26 08:28:42

学习版主大作！

andymark · 发表于 2012-6-26 08:31:19

谢谢6D

xuwenning · 发表于 2012-6-26 08:43:58

学习
收下

layaman_999 · 发表于 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
'这个是我写的一个，不知是否可行？

ljp518 · 发表于 2012-6-26 09:03:06

谢谢分享！

Henry D. Sy · 发表于 2012-6-26 17:14:41

'---------------------------------------------------------------------------------------
' Procedure : DeliveryDay
' DateTime : 2012-6-25 23:25
' Author : Henry D. Sy
' 参数 : OrderDate 下单日期
'
' : intPeriod 交货周期（以天为单位）
'
'根据下单日期及交货周期计算剔除非工作日（周六，日）以及五一，国庆，元旦之交货日期
'按理：交货日期=下单日期+周期+非工作日天数，但加上这段额外的天数中也许又有周六日
'本例的重点就是利用递归函数来计算这非工作日中的非工作日.....
'---------------------------------------------------------------------------------------
'
Public Function DeliveryDay(OrderDate As Date, intPeriod As Integer) As Date
Dim i As Integer '循环变量
Dim NWD As Integer '保存非工作日天数(Non_Work_Days)
Dim myDate As Date '生产期间每天的日期，用来判断是否为NWD
Dim gDate As Date '计算过程中的临时日期值
On Error GoTo DeliveryDay_Error
For i = 1 To intPeriod '这里i取值从1开始，不考虑0，因为接单当日无需判断是否工作日
myDate = DateAdd("d", i, OrderDate)
If Weekday(myDate) = 1 Or Weekday(myDate) = 7 Then
NWD = NWD + 1
End If
'下面考虑五一，国庆，元旦
If Right(Format(myDate, "yyyymmdd"), 4) = "0501" Or _
Right(Format(myDate, "yyyymmdd"), 4) = "0101" Then
NWD = NWD + 1
ElseIf Right(Format(myDate, "yyyymmdd"), 4) = "1001" Then
NWD = NWD + 3
End If
Next
'判断及计算工作日结束
gDate = DateAdd("d", intPeriod, OrderDate) '在不考虑工作日时：交货日期=下单日期+周期
'下面开始考虑工作日
If NWD = 0 Then '没有非工作日
DeliveryDay = gDate '交货日期=下单日期+周期
'有非工作日
Else
DeliveryDay = DeliveryDay(gDate, NWD) '为了计算加上非工作日天数后的非工作日，这里函数引用自己本身（递归），继续循环计算至NWD=0
End If
On Error GoTo 0
Exit Function
DeliveryDay_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") "
End Function

复制代码

现在增加考虑五一，元旦，国庆
请兄弟们一起来增加春节，端午，中秋

Henry D. Sy · 发表于 2012-6-27 10:20:14

增加
农历节日

tmtony · 发表于 2012-6-27 12:43:19

谢谢6D分享！

帐号		自动登录	找回密码
密码			注册

群介绍
Access培训群 (792054000)
Access免费培训2群 (163530137)
Access免费培训群 (833510950)
Access免费培训群2 (792054000)
Access交流总群 (5004108)

主题相关群

地区相关群[您还没设置居住地]

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

本帖子中包含更多资源

群介绍
主题无相 (随机显示版	同地区群块其他地区)