「何年と何日前」と表示したい

質問

Sub test1()
Dim dtm日付 As Date
Dim i As Integer

dtm日付 = #1/1/2010#

i = Date - dtm日付

MsgBox i & "日前"

End Sub
これで、何日前かは取得できたのですが
何年と何日形式にするにはどうすればいいでしょうか

回答No.3

imogasi · ベストアンサー

下記が不都合な結果が出るちか、間違ったことを言っているようなら済みません。
参考にしてください。
--
http://officetanaka.net/excel/vba/function/DateDiff.htm
エクセルVBAにもDateDiff関数があります。
ーー
（原理）
エクセルの日付データは、日付シリアル値という、１９００年１月１日からの
カレンダー的な日付の、その日が何番目の日付になるかという正整数を持ってます。
だから２つの日付の日付シリアル値を「（整数の）引き算」をすれば、２つの日付間の日数はすぐ出せます。
しかし、３６５日以上の日数が予想される場合、３６５日を単位に年数を計算すると
（割り算して商を使う）年お出す方法よりも、１年が、３６５日、３６６日あったりするので、たぶん質問者のいう、１年と違う場合が出るだろうと推測する。
ーー
貴社などの場合、何年とか何か月というのは「応当日」主義で考えるのではないですか。
何か月先の同日経過で何か月と数える。FROMTOのTOの日付で、少の月で月末に応当日がなければ、月末日越えで月数を＋１するような計算では。
ーー
エクセル（ワークシート＝普通の関数）関数DATEDIFでは
（１）引数にYを指定して、満年数を出し、
（２）それと別に、１年未満月数を出す　YMを指定の関数と
（３）日を出す引数　MD（１か月未満の日）をだし
３つの関数の結果の数を（年月日の単位など付けて）＆で結合して、表現しては
どうでしょう。内容的にはこれの計算ではないですか。
例として　関数は３セルに
=DATEDIF(A1,B1,"Y")　ＤＩＦＦではない
=DATEDIF(A1,B1,"YM")
=DATEDIF(A1,B2,"MD")
結果は、シートのA1:C3
2014/2/1 2016/4/19 2
2014/2/1 2016/4/19 2
2014/2/1 2016/4/19 18
ーー
それでエクセルVBAでも使える関数DateDiffを使い、できるかな、とやってみようとした。
しかしDateDiffの引き数に、ＹＭやＭＤが無いようだ。
Sub test01()
'--以下は使えないと思う例
d1 = Range("A1")
d2 = Range("B1")
df = d2 - d1
MsgBox df
dy = DateDiff("yyyy", d1, d2)
dm = DateDiff("m", d1, d2)
dd = DateDiff("d", d1, d2)
MsgBox dy & "年" & dm & "月" & dd & "日"
'---以下は１方法。面倒ですが
'シートの関数を入れて、計算 結果を使って表示
MsgBox [C1] & "年" & [c2] & "月" & [c3] & "日" '[C1]はＣ１セルの値の書き方
End Sub
最後の行あたりのやり方は、苦肉の策。
ーー
dd = Application.WorksheetFunction.DateDif(d1, d2, "d")はエラーになるよう。
ＶＢＳｃりｐｔのＤａｔｅｄｉｆ関数もエクセル関数のような引数がない。
ーー
VBAで、自己計算で、年、月、日を出すのはやめた方がよさそうに思う。場合分けとテスト
が複雑となる思う。
ーー
小生は、あまり実戦でこれらをゴリゴリ使う機会はなく、テストも面倒なので、質問者の
方でいろいろやってみて、納得して使ってください。

お礼

ありがとうございます。

回答No.2

kagakusuki

「dtm日付に格納されている日付よりも後の日付で、月と日が本日現在の日付と同じ日付の内、最も古い日の日付」を求めて変数bufに格納してから、変数bufの日付が本日現在の日付の何年前の日付なのかという事と、変数bufの日付が「dtm日付に格納されている日付」の何日後なのかを求めれば良いと思います。

Sub test2()

Dim dtm日付 As Date
Dim buf As Date
Dim myTerm As String

dtm日付 = #4/21/2014#
buf = DateSerial(Year(dtm日付), Month(Date), Day(Date))
If DateDiff("d", dtm日付, buf) < 0 Then _
buf = DateAdd("yyyy", 1, buf)
myTerm = Trim(Replace(" " & DateDiff("yyyy", buf, Date) _
& "年" & DateDiff("d", dtm日付, buf) & "日前", " 0年", ""))
MsgBox myTerm

End Sub

お礼

ありがとうございます。

回答No.1

ubku

かなり泥臭いですが
Sub test()

Dim d1 As Date
Dim d2 As Date

d1 = #2/1/2016#
d2 = #3/1/2020#

Dim dd As Double
Dim yd As Double
Dim d3 As Date
Dim strYear As String

yd = DateDiff("yyyy", d1, d2)
'月日を比較（閏年で）
If CDate("2016/" & Format(d1, "MM/dd")) <= CDate("2016/" & Format(d2, "MM/dd")) Then
d3 = DateAdd("yyyy", yd, d1)
strYear = yd
Else
d3 = DateAdd("yyyy", yd - 1, d1)
strYear = yd - 1
End If
dd = DateDiff("d", d3, d2)

MsgBox (strYear & "年と" & dd & "日")

End Sub

お礼

ありがとうございます。