fork download
copy 
  1. Public Sub 経過年月日設定()
  2.     Range("B4").Value = ktDATEDIF(Range("A4").Value, Range("B1").Value, "Y")
  3.     Range("C4").Value = ktDATEDIF(Range("A4").Value, Range("B1").Value, "YM")
  4.     Range("D4").Value = ktDATEDIF(Range("A4").Value, Range("B1").Value, "MD")
  5. End Sub
  6.  
  7.  
  8. Public Function ktDATEDIF(ByVal StartDate As Date, _
  9.                           ByVal EndDate As Date, _
  10.                           ByVal Interval As String) As Variant
  11. ' [Interval]
  12. '    YMD :"y年mヶ月d日"で編集(文字列)
  13. '    Y   :期間内満年数
  14. '    M   :期間内満総月数
  15. '    YM  :年未満の端数の月数
  16. '    MD  :月未満の端数の日数
  17. '    YD  :年未満の端数の日数
  18. '    FR  :年比率(Double型, YEARFRACモード)
  19.  
  20. '(注)
  21. ' Interval="FR"は、YEARFRAC関数の[基準:1(Actual/Actual)]に相当しますが、
  22. ' YEARFRACとは計算方法が異なり、『抽象的２月２９日説』に基づいています。
  23. ' 実務規則に合致しているかを確認してから利用して下さい。
  24. ' (例)
  25. '  2003/5/10 - 2007/6/20 → 4年41日間 → 4.1120218579 ( = 41/366)
  26. '    [2003/5/10(ex) - 2007/5/10(in)]で４年間。[2007/5/11(in) - 6/20(in)]で４１日間。
  27. '    [2007/5/11(in) - 6/20 - 2008/5/10(in)]の間に2/29があるので366日/年。
  28. '
  29. '  2003/5/10 - 2008/6/20 → 5年41日間 → 5.1123287671 ( = 41/365)
  30. '    [2003/5/10(ex) - 2008/5/10(in)]で５年間。[2008/5/11(in) - 6/20(in)]で４１日間。
  31. '    [2008/5/11(in) - 6/20 - 2009/5/10(in)]の間に2/29がないので365日/年。
  32.  
  33. Dim wkDate As Date
  34. Dim lngMonth As Long                '総月数(13ヶ月 など)
  35. Dim intYear As Integer
  36. Dim intMonth_in_Year As Integer     '年未満の月数
  37. Dim intDay_in_Month As Integer      '月未満の日数
  38. Dim intDay_in_Year As Integer       '年未満の日数
  39. Dim dblFrac As Double
  40. Dim intFracDays As Integer          '[年未満の日数]部分の初日から１年間の日数
  41.                                     '(その１年間に2/29がある→366、ない→365)
  42.  
  43.   If (StartDate > EndDate) Then
  44.     ktDATEDIF = CVErr(xlErrValue)
  45.     'ktDATEDIF = "Error"            'OOo.BasicではCVErr(xlErrValue)が使えない
  46.     Exit Function
  47.   End If
  48.  
  49.   '注)[DateDiff関数]自体は初日不算入で処理している
  50. ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  51.   If (Day(StartDate + 1) = 1) Then
  52.     '起算日が１日(開始日が月末日)の場合､月の大小閏に係わりなく
  53.     '[月末日]までで『丸Ｎヶ月』
  54.     '月の大小閏に影響されないように「月末日～終了日」を１日分シフトして
  55.     '「１日～(終了日+1)」で求める。
  56.     lngMonth = DateDiff("m", (StartDate + 1), (EndDate + 1))
  57.     intYear = lngMonth \ 12
  58.     intMonth_in_Year = lngMonth Mod 12
  59.     If (Day(EndDate + 1) = 1) Then      '満了日(終了日)が月末か？
  60.       intDay_in_Month = 0
  61.     Else
  62.       intDay_in_Month = Day(EndDate)
  63.     End If
  64.  
  65.     wkDate = DateAdd("yyyy", intYear, (StartDate + 1))     '(StartDate+1)は[１日]
  66.     intDay_in_Year = DateDiff("d", wkDate, (EndDate + 1))
  67.  
  68.     If (intDay_in_Year > 0) Then
  69.         intFracDays = DateAdd("yyyy", 1, wkDate) - wkDate      '365 or 366
  70.     End If
  71.   Else
  72.     '起算日≠１日の場合､「起算日の応当日前日」までで『丸Ｎヶ月』
  73.     lngMonth = DateDiff("m", StartDate, EndDate)
  74.     wkDate = DateAdd("m", lngMonth, StartDate)
  75.     If (wkDate > EndDate) Then
  76.       lngMonth = lngMonth - 1
  77.       wkDate = DateAdd("m", lngMonth, StartDate)
  78.     End If
  79.     intDay_in_Month = DateDiff("d", wkDate, EndDate)
  80.     intYear = lngMonth \ 12
  81.     intMonth_in_Year = lngMonth Mod 12
  82.  
  83.     wkDate = DateAdd("yyyy", intYear, StartDate)
  84.     intDay_in_Year = DateDiff("d", wkDate, EndDate)
  85.  
  86.     If (intDay_in_Year > 0) Then
  87.         intFracDays = DateAdd("yyyy", 1, wkDate) - wkDate      '365 or 366
  88.     End If
  89.   End If
  90.  
  91. ' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  92.   Select Case UCase(Interval)
  93.     Case "YMD"
  94.       ktDATEDIF = intYear & "年" & intMonth_in_Year & "ヶ月" & intDay_in_Month & "日"
  95.     Case "Y"
  96.       ktDATEDIF = intYear
  97.     Case "M"
  98.       ktDATEDIF = lngMonth
  99.     Case "YM"
  100.       ktDATEDIF = intMonth_in_Year
  101.     Case "MD"
  102.       ktDATEDIF = intDay_in_Month
  103.     Case "YD"
  104.       ktDATEDIF = intDay_in_Year
  105.     Case "FR"
  106.       If (intDay_in_Year > 0) Then
  107.         dblFrac = intDay_in_Year / CDbl(intFracDays)  '整数演算とならないように型変換
  108.         ktDATEDIF = CDbl(intYear + dblFrac)
  109.       Else
  110.         ktDATEDIF = CDbl(intYear)               '年未満の日数が無いので小数は出ない
  111.       End If
  112.     Case Else
  113.       ktDATEDIF = CVErr(xlErrValue)
  114.       'ktDATEDIF = "Error"            'OOo.BasicではCVErr(xlErrValue)が使えない
  115.   End Select
  116. End Function
  117.  
  118.  
Not running #stdin #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/akVk8F
language:
Text (text 6.10)
created:
2 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!