• ベストアンサー

該当の日付時点で該当者が何歳かを取得したいのですが

Sub Macro1() Dim dtm日付 As Date Dim dtm誕生日 As Date Dim i As Integer dtm日付 = #10/1/2015# dtm誕生日 = #7/1/1986# i = dtm日付 - dtm誕生日 MsgBox "Aさんは" & dtm日付 & "の時点では、" & i & "才です。" End Sub こんな感じでVBAコードを作ってみたのですが 肝心の何歳かを算出する方法がわかりません。

質問者が選んだベストアンサー

  • ベストアンサー
回答No.8

Sub Macro1()   Dim dtm日付 As Date   Dim dtm誕生日 As Date   dtm日付 = #10/1/2015#   dtm誕生日 = #7/1/1986#   MsgBox "Aさんは" & dtm日付 & "の時点では、" & GetAge(dtm誕生日,dtm日付) & "才です。" End Sub このように、普通は年齢計算関数を利用します。 Public Function GetAge(ByVal dteBirthday As Date, ByVal dteToday As Date) As Integer   Dim lngValue_1 As Long   Dim lngValue_2 As Long   dteToday = DateAdd("d", 1, dteToday)   lngValue_1 = Format(dteToday, "yyyy") * 10000 + Format(dteToday, "mm") * 100 + Format(dteToday, "dd")   lngValue_2 = Format(dteBirthday, "yyyy") * 10000 + Format(dteBirthday, "mm") * 100 + Format(dteBirthday, "dd")   GetAge = Fix((lngValue_1 - lngValue_2) / 10000) End Function

ljarzqtamp
質問者

お礼

ありがとうございました。

その他の回答 (7)

回答No.7

#2、3、5、6です。 何度も何度もすみません。 #3のコードも閏日で弾かれてしまいますね。ゴメンナサイ。 徹夜仕事の合間不調だったこともあるけれど、余りにも散漫でした。 過去に書いた稼動中のコードと検証用のブックを浚って、 #3と同趣旨のもので再検証しました。 最初に回答に着手した時には、もっとスマートなやり方があるような 錯覚があって、あれやこれや錯綜してしまいましたが、 結局、#1さんのご回答で十分でしたね。 でもまぁ#3での狙いに関しては、こちらの趣旨にも主張はあることですし、 比較する日付の取得方法によっては寧ろ応用が利く場合もあるという含みで、 参考程度に、正したものをあげておきます。 ##長、失礼しました。 一旦、  それぞれの日付の'年'の差を求めておいて、 次に、  誕生日と該当の日付の'月日'について、比較の為、  閏年である"1996"年の'月日'として #10/1/1996# と #7/1/1996#  を比較して、該当の日付が誕生日前なら'年'の差から1引く というように年齢を求めます。 ' ' /// Sub Re9005618wE() Dim dtm日付 As Date Dim dtm誕生日 As Date Dim i As Integer   dtm日付 = #10/1/2015#   dtm誕生日 = #7/1/1986#   i = Year(dtm日付) - Year(dtm誕生日)   If CDate("1996/" & Format(dtm誕生日, "m/d")) > CDate("1996/" & Format(dtm日付, "m/d")) Then i = i - 1   MsgBox "Aさんは" & dtm日付 & "の時点では、" & i & "才です。" End Sub ' ' ///

ljarzqtamp
質問者

お礼

ありがとうございました。

回答No.6

あちゃ、また間違えてしまいました。すみません。 #2に続いて#5も正しく機能しませんので撤回します。失礼しました。 結局#3のコードだけです。私のは。

ljarzqtamp
質問者

お礼

ありがとうございました。

回答No.5

#2,3です。 はぁ。それではこちらも、現役のVBA関数を使った方法も追加で紹介しておきます。 ぐっと簡単に書けるのですが、私はあまり使わないですし、 特にお奨めもしていません。 計算の仕方の習得よりも、簡単に結果が得られる方法をお求め ということでしたらば、こちらをどうぞ。 ' ' /// Sub Re9005618wf() Dim dtm日付 As Date Dim dtm誕生日 As Date Dim i As Integer   dtm日付 = #7/1/2015#   dtm誕生日 = #7/1/1986#   i = DateDiff("yyyy", dtm誕生日, dtm日付)   MsgBox "Aさんは" & dtm日付 & "の時点では、" & i & "才です。" End Sub ' ' ///

ljarzqtamp
質問者

お礼

ありがとうございました。

  • kagakusuki
  • ベストアンサー率51% (2610/5101)
回答No.4

 dtm日付の月日がその年の誕生日の前であるのか後であるのかという事を考えなくとも、DATEDIF関数を使えば一発で求める事が出来ます。 Sub QNo9005618_該当の日付時点で該当者が何歳かを取得したいのですが() Dim dtm日付 As Date Dim dtm誕生日 As Date Dim i As Byte dtm日付 = "10/1/2015" dtm誕生日 = "7/1/1986" If dtm日付 >= 1 And dtm誕生日 >= 1 Then If dtm日付 >= dtm誕生日 Then i = Evaluate("DATEDIF(""" & dtm誕生日 & """,""" & dtm日付 & """,""y"")") MsgBox "Aさんは" & dtm日付 & "の時点では、" & i & "才です。", vbInformation, "年齢" Else MsgBox "指定された日付が誕生日よりも前の日付であるため年齢を計算できません。", vbExclamation, "無効な値" End If Else MsgBox "日付が指定されていません。", vbExclamation, "データ無し" End If End Sub

ljarzqtamp
質問者

お礼

ありがとうございました。

回答No.3

#2です。 錯覚があって誤った解答をしてしまいました。 #2のコードは撤回します。 一旦、  それぞれの日付の'年'の差を求めておいて、 次に、  '月日'の大小を比較して、該当の日付が誕生日前なら'年'の差から1引く というように年齢を求めます。 概念的には、よりわかり易いものになっているかと思います。 #拙速なミスでご迷惑お掛けしました。すみません。 ' ' /// Sub Re9005618w() Dim dtm日付 As Date Dim dtm誕生日 As Date Dim i As Integer   dtm日付 = #10/1/2015#   dtm誕生日 = #7/1/1986#   i = Year(dtm日付) - Year(dtm誕生日)   If CDate(Format(dtm誕生日, "m/d")) > CDate(Format(dtm日付, "m/d")) Then i = i - 1   MsgBox "Aさんは" & dtm日付 & "の時点では、" & i & "才です。" End Sub ' ' /// #失礼しました。

ljarzqtamp
質問者

お礼

ありがとうございました。

回答No.2

こんにちは。 算出方法は、誕生日が来れば年をひとつ加える一般的なものだとして、 要点は、誕生日を迎えているかどうかの判別をどう反映させるか、 という一点になります。 色んな方法がありますけれど、比較的易しい方法で提示します。 ' ' /// Sub Try9005618w() Dim dtm日付 As Date Dim dtm誕生日 As Date Dim i As Integer   dtm日付 = #10/1/2015#   dtm誕生日 = #7/1/1986#   i = Year(dtm日付 - Format(dtm誕生日 - 1, "y")) - Year(dtm誕生日)   MsgBox "Aさんは" & dtm日付 & "の時点では、" & i & "才です。" End Sub ' ' /// 例示に副って説明すると、  Year(dtm日付 - Format(dtm誕生日 - 1, "y"))   該当の日付 #10/1/2015#    dtm日付 から   生年月日の月日 7/1 の一日前の日付 6/30 までの年次経過日数 181日    Format(dtm誕生日 - 1, "y")を引いた日付の'年'を(Year()関数で)求める  Year(dtm誕生日)   生年月日の'年'を(Year()関数で)求める 2つの年の差を求めたものが、該当の日付時の年齢、になります。 Date型のシリアル値について、  内部的には数値であること、  1日は、数値の1と同値であること、 を理解して貰えれば、 後は算数的に引き算するだけです。 Year()関数 Format()関数  Format()関数の第2引数formatに指定する、年次経過日数を表す"y" 等についてはVBAのヘルプやWeb検索等を参考に どういうものなのか、そちらで確認してみてください。 以上です。

ljarzqtamp
質問者

お礼

ありがとうございました。

noname#212058
noname#212058
回答No.1

「 i = dtm日付 - dtm誕生日」で計算しようとすると、「うるう日」の扱いが面倒なのでやめたほうが良いですよ。 If Month(dtm日付) < Month(dtm誕生日) Or (Month(dtm日付) = Month(dtm誕生日) And Day(dtm日付) < Day(dtm誕生日)) Then  ' まだ今年の誕生日が来ていない  i = Year(dtm日付) - Year(dtm誕生日) - 1 Else  ' もう今年の誕生日が来た  i = Year(dtm日付) - Year(dtm誕生日) End If MsgBox "Aさんは" & dtm日付 & "の時点では、" & i & "才です。"

ljarzqtamp
質問者

お礼

ありがとうございました。

関連するQ&A

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

    Sub test1() Dim dtm日付 As Date Dim i As Integer dtm日付 = #1/1/2010# i = Date - dtm日付 MsgBox i & "日前" End Sub これで、何日前かは取得できたのですが 何年と何日形式にするにはどうすればいいでしょうか

  • 今日より何日経過しているかを取得するには?

    Sub Macro() Dim dtm日付 As Date dtm日付 = #1/1/2015# If dtm日付 Then MsgBox "何日前です" End If End Sub のように、dtm日付が今日より何日前かを取得する方法はありますか?

  • 今の自分の年齢を取得するvbaコードが知りたい

    今の自分の年齢を取得するvbaコードが知りたいのですが Sub test1() Dim dtm誕生日 As Date dtm誕生日 = #7/1/1986# MsgBox Format(Date - dtm誕生日, "yyyy/mm/dd") MsgBox DateDiff("yyyy", dtm誕生日, Date) End Sub を作ってみたのですが 違うのが返りました。 DateDiff("yyyy", dtm誕生日, Date) は、30が返ってしまいます。 今日の時点ではまだ29歳なのですが そういう場合どうすればいいでしょうか? 「現在は29歳です」と返したいのですが、 どのようにすればいいでしょうか?

  • エクセルVBAの次のコードの意味教えて下さい。

    Sub macro1() Dim a As Integer, b As Integer a = 1 b = 5 macro2 a, b MsgBox a + b End Sub Sub macro2(c As Integer, d As Integer) c = c * 10 d = d * 5 End Sub 答えは35と出ます。 よろしくお願いします。

  • VBA での日付の計算

    お世話になってます。 Access VBA 初心者です。 string型変数に日付(YYYYMMDD)がセットされています。 その日付に1日プラスした日付を算出したいのですが、 どうすればよいのかよく分かりません。 たとえば Dim w_Date As String w_Date = "20070726" としたならば、 w_Dateは"20070727"となるようにしたいのですが。。。 よろしくお願いいたします。

  • フォルダのファイル数をvbaで取得したい

    vbaなのですが、フォルダにgifファイルがたくさんはいっていますが、 その数を数えるコードを教えてください。 今は、 Sub Macro7() Dim File As String Dim i As Long File = Dir("C:\*.*", vbDirectory) Do While File <> "" File = Dir i = i + 1 Loop MsgBox "ファイル数は" & i & "です" End Sub のように、全てのファイル数をカウントして求めています。

  • 数値かどうかを取得したい IsNumberではダメ

    Sub Macro2() Dim mystr As String mystr = "1" If IsDate(mystr) = False Then MsgBox "NO" End If End Sub これなら日付型かどうかを取得できるのに、 Sub Macro1() Dim mystr As String mystr = "1" If IsNumber(mystr) = False Then MsgBox "NO" End If End Sub だと、IsNumberがコンパイルエラーになります。 変数に入っている値が数値として評価できるかを取得する方法を教えてください。

  • ただ、今日の日付を求めたいときはどちらのVBAコー

    VBA初心者のため教えてほしいのですが ただ、今日の日付を求めたいときはどちらのVBAコードを使えばいいですか? Sub test1() MsgBox DateValue(Date) End Sub Sub test2() MsgBox Date End Sub です。 ご教授よろしくお願いします。

  • VBAのプロシージャーと変数の名前の区別について

    VBAの初心者です。教えてください。 Sub ex() Dim a As Integer Dim b As Integer a = 2 a a, b MsgBox b End Sub Sub a(a As Integer, b As Integer) b = a End Sub 上記のプログラムを実行するとうまくいきません。VBAのプロシージャーと変数って同じ名前を使うとだめなのですか?教えてください。

  • 変数が勝手に変わります

    Dim i As Integer:Dim i2 As Integer:Dim card(5) As Integer:Dim expectPoint0card(1) As Integer '0枚のカードを交換する場合のすべての選択肢の期待値 Dim expectPoint1card(5) As Integer Sub porkerGame() card(1) = 1: card(2) = 2: card(3) = 3: card(4) = 4: card(5) = 5 getExpectPoint1card expectPoint1card End Sub Sub getExpectPoint1card(expectPoint1card() As Integer) Dim tesu1 As Integer:Dim sum1 As Integer For i = 1 To 5 getTesuSum1 i, tesu1, sum1 expectPoint1card(i) = sum1 / tesu1 Next i End Sub Sub getTesuSum1(rowNumber As Integer, tesu1 As Integer, sum1 As Integer) Dim card2(5) As Integer:tesu1 = 0:sum1 = 0 MsgBox rowNumber copy card, card2, 5 MsgBox rowNumber For i = 4 To 55 MsgBox rowNumber card2(rowNumber) = i addTesuSum card2, tesu1, sum1 Next i End Sub Sub copy(row() As Integer, row2() As Integer, i2 As Integer) For i = 1 To i2 row2(i) = row(i) Next i End Sub 上記のプログラムで、ウィンドウに1,6,4,5,6と表示され、その次には、エラーが表示します。僕は、ウィンドウに表示される変数RowNumberの値がしばらくの間は1のままであるようにプログラムを書いたつもりなのですが、変数rowNumberの値が変わるのは、どうしてでしょうか?教えてください。お願いします。

専門家に質問してみよう