当函数根据变量迭代添加天数/月时，计算每个月的最大天数。
当函数根据变量迭代添加天数/月时，计算每个月的最大天数。
提问于 2019-12-05 02:06:29
我想在一些VBA代码方面提供一些帮助，因为我仍然是相对较新的。:)
问题:创建一个VBA函数，迭代地将若干天或几个月添加到基准日期，相应地将其添加到“周期性”和“截止”日期。请参考下面的图片。
最初的功能起作用了，但没有考虑到诸如“30”这样的日子。例如，如果基准日期为30/11/2019，截止日期为25/08/ 2020，则将迭代只需28天的2020年2月。在2月迭代时，变化点将变成'28/02/ 2020‘，然后在2020年3月迭代到'28/03/2020’。
因此，我想保存最大基‘转换日’，并将其重新加到最后的‘变更’。但是，查看第一行，调整后的日期返回第1行。最后的日期应为‘30/08/2020年’
任何帮助都将不胜感激！提前谢谢你！
代码#ver1：
Function getModifiedDate(newdate, cutoff, periodicity)
While newdate < cutoff
If periodicity = "Monthly" Then
newdate = DateAdd("m", 1, newdate)
ElseIf periodicity = "2-Monthly" Then
newdate = DateAdd("m", 2, newdate)
ElseIf periodicity = "Quarterly" Then
newdate = DateAdd("m", 3, newdate)
ElseIf periodicity = "6-Monthly" Then
newdate = DateAdd("m", 6, newdate)
ElseIf periodicity = "Weekly" Then
newdate = newdate + 7
ElseIf periodicity = "Fortnightly" Then
newdate = newdate + 14
End If
Wend
getModifiedDate = newdate
End Function代码#ver2：
Function getModifiedDate(changedate, cutoff, periodicity)
While changedate < cutoff
If periodicity = "Monthly" Then
changeday = Day(changedate)
changedate = DateAdd("m", 1, changedate)
lastmonthday = Application.WorksheetFunction.EoMonth(changedate, 0)
If changeday >= Day(changedate) Then
changedate = DateSerial(Year(changedate), Month(changedate), changeday)
End If
ElseIf periodicity = "2-Monthly" Then
changeday = Day(changedate)
changedate = DateAdd("m", 2, changedate)
If changeday >= Day(changedate) Then
changedate = DateSerial(Year(changedate), Month(changedate), changeday)
End If
ElseIf periodicity = "Quarterly" Then
changeday = Day(changedate)
changedate = DateAdd("m", 3, changedate)
If changeday >= Day(changedate) Then
changedate = DateSerial(Year(changedate), Month(changedate), changeday)
End If
ElseIf periodicity = "6-Monthly" Then
changeday = Day(changedate)
changedate = DateAdd("m", 6, changedate)
If changeday >= Day(changedate) Then
changedate = DateSerial(Year(changedate), Month(changedate), changeday)
End If
ElseIf periodicity = "Weekly" Then
changedate = changedate + 7
ElseIf periodicity = "Fortnightly" Then
changedate = changedate + 14
End If
Wend
getModifiedDate = changedate
End Function
回答 1
Stack Overflow用户
回答已采纳
发布于 2019-12-05 03:18:32
我建议一种不同的算法，在这种算法中，不是一次添加一个句点，而是同时添加适当数量的句点()。这样你就可以避免在几个月之间没有必要的天数的问题。
您可以通过计算changedate和cutoff之间的“周期差”来实现这一点，然后检查以确保您的结果不少于cutoff。
您还应该添加一个检查和结果，以防周期性不是指定类型之一。可能有一个Case Else语句。
例如：
Option Explicit
Function getModifiedDate(changedate As Date, cutoff As Date, periodicity As String) As Date
Dim L As Long
Dim dtTemp As Long
'Sanity check
If changedate > cutoff Then
getModifiedDate = changedate 'or cutoff, depending on what you want
Exit Function
End If
Select Case periodicity
Case "Monthly"
L = DateDiff("m", changedate, cutoff)
dtTemp = DateAdd("m", L, changedate)
getModifiedDate = DateAdd("m", L + IIf(dtTemp < cutoff, 1, 0), changedate)
Case "2-Monthly"
L = DateDiff("m", changedate, cutoff) \ 2
dtTemp = DateAdd("m", L * 2, changedate)
getModifiedDate = DateAdd("m", L * 2 + IIf(dtTemp < cutoff, 2, 0), changedate)
Case "6-Monthly"
L = DateDiff("m", changedate, cutoff) \ 6
dtTemp = DateAdd("m", L * 6, changedate)
getModifiedDate = DateAdd("m", L * 6 + IIf(dtTemp < cutoff, 6, 0), changedate)
Case "Quarterly"
L = DateDiff("q", changedate, cutoff)
dtTemp = DateAdd("q", L, changedate)
getModifiedDate = DateAdd("q", L + IIf(dtTemp < cutoff, 1, 0), changedate)
Case "Weekly"
L = DateDiff("ww", changedate, cutoff)
dtTemp = DateAdd("ww", L, changedate)
getModifiedDate = DateAdd("ww", L + IIf(dtTemp < cutoff, 1, 0), changedate)
Case "Fortnightly"
L = DateDiff("ww", changedate, cutoff) \ 2
dtTemp = DateAdd("ww", L * 2, changedate)
getModifiedDate = DateAdd("ww", L * 2 + IIf(dtTemp < cutoff, 2, 0), changedate)
End Select
End Function
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/59187180
复制相关文章
相似问题
腾讯云开发者
