• ベストアンサー

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

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

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

  • ベストアンサー
  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.6

質問には、エクセル(VBA)の問題かをはっきり書くこと。ものによってはバージョンなどもね。 ちなみに日付の表現はアクセスの場合実質似ているが少し違う面があるようだ。 エクセルであれば、エクセルの日付は日付シリアル値(整数(部分))というもので、セルの値や変数に代入した値は、日付シリアル値扱われていることを知らないのかな。小数部分で時刻を表している。 これを知っていれば、質問に値しない場合もある。 ーー 下記をやってみて、下記のように算出した日数でよければ、引き算すれば済むだけの簡単なこと。 標準モジュールに Sub test01() x = Date MsgBox x y = #3/20/2015# MsgBox x - y End Sub x - Ýはx - y+Iでよい場合もあろう。 時間も含めて考える必要(24時間たつと1日とか、何時を過ぎると+1日とかのような)がある場合などは、別になる。 質問に、正しいかどうか不明なVBAのコードを載せるのも良いが、日本語で、質問には例でも挙げて質問するべきだ。本来読者側で、こういう疑問もでそうだ、と先回りできるだけの想像力が出きてこそ、VBAを勉強するレベルだと思う。 VBAをやるというレベルなら、日付シリアル値というものは当然知っているべきことと思う。

noscilbgqrjod
質問者

お礼

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

その他の回答 (5)

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

 MsgBoxを表示するのは共通の処理なのですから、ケースごとにMsgBoxを表示させるのではなく、MsgBoxで表示する文面を格納するためのString変数の値をケースごとに変える様にした上で、最後にMsgBoxを表示させる様にした方が良いと思います。 Sub QNo8944208() Dim dtm日付 As Date Dim Msginfo, myinfo(4) As String 'Msginfo:MsgBoxに表示する文面 'myinfo:MsgBoxに表示する文面の候補 Dim RemainD As Long '残りの日数 myinfo(0) = "一昨日" myinfo(1) = "昨日" myinfo(2) = "今日" myinfo(3) = "明日" myinfo(4) = "明後日" dtm日付 = #1/1/2015# RemainD = dtm日付 - Date Select Case RemainD Case Is > 2 Msginfo = "は" & Chr(13) & " " & RemainD & "日後です" Case -2 To 2 Msginfo = "は" & Chr(13) & " " & myinfo(RemainD + 2) & "です!!" Case Is < -2 Msginfo = "から" & Chr(13) & " " & -RemainD & "日が経過しました" End Select MsgBox dtm日付 & Msginfo End Sub

noscilbgqrjod
質問者

お礼

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

  • Nouble
  • ベストアンサー率18% (330/1783)
回答No.4

こういうのではダメですか? Function 日数差1(ByRef 日付古 As Date ,ByRef  日付新 As Date) As Date  日数差1 = ABS(日付新 - 日付古) End Function Function 日数差2(ByRef 日付古 As Date ,ByRef  日付新 As Date) As Date Dim  Temp As Date Const 日 = "D"  If 日付新 < 日付古 _  Then   Temp = 日付新   日付新 = 日付古   日付古 = Temp  End If  日数差2 = Evaluate("Datedif("日付古","日付新","日")") End Function Function Dvalue(ByVal 日付テキスト As Stling) As Date  Dvalue = Evaluate("Datevalue("日付テキスト") End Function Function 今日() As Date  今日 = Evaluate("Today()") End Function Sub 呼び出し例()  MsgBox Call 日数差1(Dvalue("2015/1/1"),今日())  MsgBox Call 日数差2(Dvalue("2015/1/1"),今日()) End Sub

noscilbgqrjod
質問者

お礼

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

回答No.3

すみません、直接的な回答が抜けてしまいました。 Sub Re8944208a() Dim dtm日付 As Date   dtm日付 = #4/1/2015#   If dtm日付 - Date > 0 Then     MsgBox dtm日付 - Date & " 日前です"   End If End Sub

noscilbgqrjod
質問者

お礼

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

回答No.2

こんにちは。 今日の日付はDate関数です。 日付と日付の差を求めるなら普通に引き算でも出来ます。 DateDiff関数を使うことも多いです。 差を求めたら、一旦、変数に格納しておいて、その変数を 条件判別と、MsgBoxで表示する日数と、2か所で使います。 Sub Re8944208() Dim dtm日付 As Date   dtm日付 = #4/1/2015# '  dtm日付 = #1/1/2015# '  dtm日付 = #3/28/2015# '  dtm日付 = #1/1/2016# Dim dtDiff As Long   dtDiff = DateDiff("d", Date, dtm日付) '  dtDiff = dtm日付 - Date      Select Case dtDiff   Case 0     MsgBox dtm日付 & "  今日です!!!"   Case 1     MsgBox dtm日付 & "  明日です!!"   Case Is < 0     MsgBox dtm日付 & " から " & -dtDiff & " 日が過ぎました"   Case Else     MsgBox dtm日付 & " まで あと " & dtDiff & " 日です"   End Select End Sub

noscilbgqrjod
質問者

お礼

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

noname#206834
noname#206834
回答No.1

エクセルですか? 例えば2001/01/01のセルと2005/05/05のセルを作って 普通に計算式(引き算)すれば経過日数出ませんでしたっけ? 自分は日数の計算表作って時々使ってます。 エクセルじゃなかったらすみません。

noscilbgqrjod
質問者

お礼

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

関連するQ&A

  • 数値かどうかを取得したい 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がコンパイルエラーになります。 変数に入っている値が数値として評価できるかを取得する方法を教えてください。

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

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

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

    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コードを作ってみたのですが 肝心の何歳かを算出する方法がわかりません。

  • 今の自分の年齢を取得する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歳です」と返したいのですが、 どのようにすればいいでしょうか?

  • 変数の中身がアルファベットだけなのか取得するには

    変数がアルファベットだけか取得するには? Sub test() Dim mystr As String mystr = "abc" If ??? Then MsgBox "アルファベットだけです" End If End Sub のように、変数の中身がアルファベットだけなのか取得するにはどうすればいいでしょうか? ひらがな、カタカナ、漢字、記号を含んでいるかどうかを評価したいです。

  • マクロ 記述が悪くエラーがかかります。

    いつも回答ありがとうございます。 最後らへんの記述で実行時エラー【型が一致しません】がかかります。 Worksheets("集計用").Range(b1, b2).Copy _ Destination:=Worksheets(b3).Range("B2") ← ここでエラーがかかる。 ワークシート名に変数を使用しているせいだと思います。 解決する方法を御指導して頂けないでしょうか?宜しくお願い致します。 Sub グラフの作成() Dim Date1 As Date Dim Date2 As Date Dim SName As String Dim b1 As Variant Dim b2 As Variant Dim b3 As Variant Dim d1 As Variant Dim d2 As Variant Dim d3 As Variant With Worksheets("集計用") s1: Date1 = Application.InputBox("最初の日付を2012/12/1のように入力してください。") If Date1 = 0 Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b1 = .Columns("B").Find(Date1, , xlValues, 1) If b1 Is Nothing Then If MsgBox("入力した日付が見当たりません。" & vbNewLine & _ "再度入力しますか?", vbYesNo) = vbYes Then GoTo s1 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d1 = b1.Row s2: Date2 = Application.InputBox("最初の日付を2012/12/31のように入力してください。") If Date1 = 0 Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b2 = .Columns("B").Find(Date2, , xlValues, 1) If b2 Is Nothing Then If MsgBox("入力した日付が見当たりません。" & vbNewLine & _ "再度入力しますか?", vbYesNo) = vbYes Then GoTo s2 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d2 = b2.Row s3: SName = Application.InputBox("商品名を入力して下さい。") If SName = "False" Then MsgBox "キャンセルされました。", vbOKOnly Exit Sub End If Set b3 = .Rows("3").Find(SName, , xlValues, 1) If b3 Is Nothing Then If MsgBox("入力した商品名が見当たりません。" & vbNewLine & _ "再度入力しますか?", vbYesNo) = vbYes Then GoTo s3 Else MsgBox "処理を中止しました", vbOKOnly Exit Sub End If End If d3 = b3.Column End With Worksheets.Add After:=Worksheets("集計用") ActiveSheet.Name = b3 Worksheets("集計用").Range(b1, b2).Copy _ Destination:=Worksheets(b3).Range("B2") Worksheets("集計用").Range(Cells(d1, d3), Cells(d2, d3)).Copy _ Destination:=Worksheets(b3).Range("C2") End Sub

  • 角カッコが含まれてるかどうかをlikeで取得

    したいのですが、どうやらエラーになるようです。 Sub test() Dim mystr As String mystr = "[test]" If mystr Like "*[*" Then MsgBox "[が含まれます" End If End Sub だと、実行時エラー93 パターン文字列が不正ですになります。 こういうように各カッコが含まれてるかどうかを取得するにはどうすればいいですか?

  • ファイルが既に開いているかどうかを取得するには

    Sub Sample1() Dim App As Object Dim MyFileName As String Set App = CreateObject("Excel.Application") MyFileName = "C:\Users\test.xlsm" With App .Workbooks.Open Filename:=MyFileName .Visible = True If .ReadOnly Then MsgBox "既に開いています" App.Quit '既に開いているのなら、閉じる End If End With End Sub このようなコードを作ったのですが、どうやらIf .ReadOnly Thenの部分が間違っているようです。 エラーになります。 既にファイルが開いているか、読み取り専用かどうかを取得するコードをご教授ください。

  • Access 日付範囲の条件指定

    いつも質問ばかりですいません。 指定の日付範囲外の値に対してメッセージを出して再入力させたいのですが上手くいきません。 《条件》 今日より先は NG 今日より2日以上前は NG 1日前:OK 今日:OK Dim txt01 As Date ' Dim txt02 As String ' Dim txt03 As Integer Dim ckDate As Date ckDate = Date - 2 '日付のチェック If IsNull(Me.txt01) Then 'Nullチェック MsgBox "txt01=Null" Me.txt01.SetFocus Exit Sub ElseIf IsDate(Me.txt01) <> True Then MsgBox "日付形式ではありません。" Me.txt01.SetFocus Exit Sub ElseIf Me.txt01.Value < Date Then '前チェック Debug.Print Me.txt01.Value MsgBox "今日より先" Me.txt01.SetFocus Exit Sub ElseIf Me.txt01.Value <= ckDate Then MsgBox "2日以上前!" Me.txt01.SetFocus Exit Sub End If 2番目の、Elseifからの日付範囲の条件設定が上手くいきません。 Me.txt01.valueの後ろを"<"を">"にしたり、"="を付けたりしましたが、希望通りになりません。 多分、もっとスマートな書き方が有るとは思うのですが、あとあとメンテナンスしやすい書き方をお教え頂けたら幸いです。

  • キャンセルボタンをクリックしたかどうかを取得したい

    InputBoxでもしキャンセルボタンが押されたら・・・ってどうやればいいですか? Sub あああ() Dim a As String a = InputBox("文字を入れてください。") MsgBox a End Sub をした時に、キャンセルボタンをクリックしたかどうかを取得したいのですが、どうすればいいんですか? a = InputBox("文字を入れてください。") の次に Cancel = True をいれても vbCancel = True をいれてもエラーになります。 Sub あああ() Dim a As String a = InputBox("文字を入れてください。") If a = "" Then MsgBox "キャンセルが押されました" End If End Sub これだとOKでもキャンセルでもメッセージが表示されます。

専門家に質問してみよう