Access 日付範囲の条件指定

このQ&Aのポイント
  • 指定の日付範囲外の値に対してメッセージを出して再入力させたいのですが上手くいきません。
  • 日付のチェックを行い、条件に合わない場合はメッセージを表示して再入力を促すことができません。
  • 条件としては、今日より先の日付や2日以上前の日付はNGとし、1日前や今日の日付はOKとします。
回答を見る
  • ベストアンサー

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の後ろを"<"を">"にしたり、"="を付けたりしましたが、希望通りになりません。 多分、もっとスマートな書き方が有るとは思うのですが、あとあとメンテナンスしやすい書き方をお教え頂けたら幸いです。

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

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

#3 の NotFound404 でござります。 お恥ずかしい限りです。呆けてます。 orz 前回同様、只今 @酔 なので、ご質問者さまには『ごめんなさい』 #2/4/5さんへ 私に限って言えば、 ドンドンじゃんじゃんバンバンがんがん駄目出しをください。 お気遣いはご無用です。 技術的な話は、それが肝要かと思います。 (でも、やさしくお願い致いしたくです。「ヒック」zzz) ・・・と昨夜に投稿するつもりで寝てしまったようです。。。 これだけだとサイトの規定により丸ごと削除されるかもしれないので ちょっと別案。 日付の手入力ではなくコンボボックスなどで選択するようにした方が ユーザーさんは手間が省けてよいかも? 仮に「コンボ日付」というコンボボックスを作成し フォームの読み込み時イベントでに Private Sub Form_Load() Me!コンボ日付.RowSourceType = "value list" Me!コンボ日付.RowSource = "今日;" & Date & ";昨日;" & Date - 1 End Sub とし 「コンボ日付」のプロパティは データタブ 値集合タイプに、値リスト 連結列に、2 入力チェックに、はい 値リストの編集の許可に、いいえ 編集ロックに、はい 書式タブ 列数に、2 列幅に、1cm;3cm リスト行数に、2 リスト幅に、4cm などと設定してコンボボックスから選んでもらうのはいかが? コンボ日付をプルダウンすると 今日|2014/1/27 昨日|2014/1/26 と表示されます。 連結列が2に設定してあるので コンボ日付.Value で値が得られます。 また、コンボ日付.Column(1) でも可。 例 Private Sub コンボ日付_AfterUpdate() msgbox Me!コンボ日付.Column(0) & Me!コンボ日付.Column(1) & vbcrlf & Me!コンボ日付.Value 以下省略 ご参考までに。

sujinosuke00
質問者

お礼

NotFound404様 度々回答ありがとうございます。 目からうろこの発想です。 うちはPCリテラシーが低い人が多いので、このやり方が一番簡単で良いと面ます。

その他の回答 (5)

  • bin-chan
  • ベストアンサー率33% (1403/4213)
回答No.5

IF文の条件を書きにくい場合は多々ありますから、 Thenで何もせず、Elseのみに処理を記述するのも良いですよ。 If cdDate =Date - 1 Or cdDate = Date Then '処理日前日と処理日当日を許可する Else '上記以外はエラーとする Msgbox "範囲外の日付が入力されました。" Exit sub End if もアリです。 #4は#3さんを批難するつもりではありませんので念のため。

sujinosuke00
質問者

お礼

bin-chan様 度々、補足ありがとうございます。 なるほど、今回の場合選択肢が2日だけですから、このやり方もありですね。 勉強になりました、ありがとうございます。

  • bin-chan
  • ベストアンサー率33% (1403/4213)
回答No.4

#2です。#3さんの回答への補足について > If cdValue <= Date And cdValue >= Date - 1 Then > Date型へ変換してもどんな日付でも通ってしまいます。 > なにか間違ってますでしょうか? #2でも指摘したことだが、不等合の向きがおかしい。 「どんな日付でも」に昨曰入れてみた? 「今曰以前で、かつ、昨日以上」がThen(エラー検知処理)って何? If cdValue > Date Or cdValue < Date - 1 Then でしょ If cdValue < Date - 1 Or Date < cdDate Then と書けばわかりやすいのかな

sujinosuke00
質問者

お礼

bin-chan様 回答ありがとうございます、どうも頭が悪いせいか条件式の評価の理解がたりてないようです。 下段の記述が私には、理解しやすいです。 この場合、ORでもよいわけですね。

回答No.3

今日と昨日の日付以外は弾きたいのだから dim dValue as variant dvalue = nz(Me.txt01,0) if not isdate(dvalue) then msgbox "日付が間違っています。入力できるのは、今日か昨日の日付だけです" exit sub end if if dvalue <= date and dvalue >= date -1 then msgbox "入力できるのは、今日か昨日の日付だけです" exit sub end if みたいな感じで良いんじゃないかと?

sujinosuke00
質問者

お礼

NotFound404様 回答ありがとうございます。 Nzの使い方が分かり非常に参考になりました。

sujinosuke00
質問者

補足

どんなデータでも日付であれば通ってしまったので、少し書換えさせて頂きました。 Private Sub コマンド8_Click() Dim txt01 As Date Dim dValue As Variant Dim cdValue As Date dValue = Nz(Me.txt01, 0) Debug.Print "--------------------" Debug.Print dValue Debug.Print TypeName(dValue) If Not IsDate(dValue) Then MsgBox "日付が間違っています。入力できるのは、今日か昨日の日付だけです" Debug.Print dValue Exit Sub Else Debug.Print "OK" End If cdValue = CDate(dValue) Debug.Print TypeName(cdValue) If dValue <= Date And dValue >= Date - 1 Then MsgBox "入力できるのは、今日か昨日の日付だけです" Exit Sub Else Debug.Print "OOKK" Debug.Print "dvalue : " & dValue & " | 型 :" & TypeName(dValue) End If End Sub インティミディエイトの値 -------------------- 2014/01/30 String OK Date OOKK dvalue : 2014/01/30 | 型 :String String型なので、評価し出来ないかと考え cdValue = cDate(dValue) 型を変換して↓を実行 If cdValue <= Date And cdValue >= Date - 1 Then -------------------- 2014/01/30 String OK Date OOKK cdvalue : 2014/01/30 | 型 :Date Date型へ変換してもどんな日付でも通ってしまいます。 なにか間違ってますでしょうか? シンプルなコーディングで、非常にわかりやすいと思ったのですが、式の評価がうまく行きません。

  • bin-chan
  • ベストアンサー率33% (1403/4213)
回答No.2

ElseIFの連続も見づらい。 > ElseIf Me.txt01.Value < Date Then '前チェック 不等号の向きが逆?今日より未来はNGなんでしょ?

sujinosuke00
質問者

お礼

bin-chan様 回答有難うございます。 不等号の組み合わせを色々試したので、こんがらがって向きが変になっていたんだと思います。

  • mshr1962
  • ベストアンサー率39% (7418/18948)
回答No.1

>2番目の、Elseifからの日付範囲の条件設定が上手くいきません。 txt01のデータ形式はなんでしょうか? DATE型なら問題ないはずなのでSTRING型でしょうか? それならば CVDate(Me.txt01.Value) とすればいいと思います。 http://access2010.kjeh34.com/k006-2/59/

sujinosuke00
質問者

お礼

mshr1962様 回答ありがとうございます、すいませn他の変数と一緒に宣言したので、ハチョリました。 Dim txt01 As Dateで宣言しているので、Date型です。

関連するQ&A

  • Access VBA

    Access2003を使用しています。 単純な質問かもしれませんがよろしくお願いします。 ログイン画面を作成しておりログイン自体はできたのですが、ログインしたときに ログイン画面を自動的に閉じたいのですが、うまくいきません。 現在の仕様では、ログイン画面(frm_ログイン)とメイン画面(frm_main)があり ログインに成功するとメイン画面が開くようになっています。 ーー以下VBAコードーー Private Sub rogin_Click() Dim a If IsNull(Me.[UserName]) Then MsgBox "IDが未入力です" Me.[UserName].SetFocus ElseIf IsNull(Me.[password]) Then MsgBox "パスワードが未入力です" Me.[password].SetFocus Else a = DLookup("パスワード", "tbl_ユーザー", "ユーザー名='" & Me.[UserName] & "'") If IsNull(a) Then MsgBox "該当する ユーザー名 は存在しません" Me.[UserName].SetFocus ElseIf StrComp(a, Me.[password], vbBinaryCompare) = 0 Then On Error GoTo Err_rogin_Click Dim stDocName As String Dim stLinkCriteria As String stDocName = "frm_main" DoCmd.OpenForm stDocName, , , stLinkCriteria Else MsgBox "パスワードが違います" Me.[password].SetFocus End If End If Exit_rogin_Click: Exit Sub Err_rogin_Click: MsgBox Err.Description Resume Exit_rogin_Click End Sub ーー以上ーー 長くなって申し訳ないのですが、どのようにすればログイン後にログイン画面(frm_ログイン)を閉じるようにできるのでしょうか? よろしくお願いします。

  • Accessログイン権限

    Access2003を使用しています。 ログイン画面を作成しておりログイン自体はできたのですが、 管理者とそうでないユーザーに分けて、ログイン時に管理者であればfrm_mainを、 そうでなければfrm_main2を開くようにしたいのですがうまくいきません。 現在の仕様では、ログイン画面(frm_ログイン)とメイン画面(frm_main、frm_main2)があり テーブル名:tbl_ユーザー フィールド名:ユーザー名、パスワード、アカウント アカウントで"1"が管理者、"2"が一般ユーザー このようになっています。 ーー以下VBAコードーー Private Sub rogin_Click() Dim a If IsNull(Me.[UserName]) Then MsgBox "ユーザー名が未入力です" Me.[UserName].SetFocus ElseIf IsNull(Me.[password]) Then MsgBox "パスワードが未入力です" Me.[password].SetFocus Else a = DLookup("パスワード", "tbl_ユーザー", "ユーザー名='" & Me.[UserName] & "'") If IsNull(a) Then MsgBox "該当する ユーザー名 は存在しません" Me.[UserName].SetFocus ElseIf StrComp(a, Me.[password], vbBinaryCompare) = 0 Then On Error GoTo Err_rogin_Click Dim stDocName As String Dim stLinkCriteria As String If アカウント = "1" Then stDocName = "frm_main" Else stDocName = "frm_main2" End If DoCmd.OpenForm stDocName, , , stLinkCriteria DoCmd.Close acForm, Me.Name Else MsgBox "パスワードが違います" Me.[password].SetFocus End If End If Exit_rogin_Click: Exit Sub Err_rogin_Click: MsgBox Err.Description Resume Exit_rogin_Click End Sub ーー以上ーー 現在はこのようになっているのですが、これだとなぜかアカウントが"1"でも"2"でも frm_mainが開いてしまいます。 長くなって申し訳ないのですが、アドバイスをお願いします。

  • vba ユーザーフォームについて

    勉強のためにvb勉強中です。エクセルのユーザーフォームについて質問です。 コンボボックス 01 02 のどちらかを選択すると、テキストに入力した数字は、01を選択したら11行、02を選択したら12行に転記できるようにしたいのですが、if文を使うのだろうと思うのですが、教えていただけないでしょうか。 私が途中まで作成した載せておきます。よろしくお願い申し上げます。 Private Sub CommandButton1_Click() Dim rc As Long Dim retu As Long Dim Ctrl As Control If Me.txtComboBox1.Value = "" Then MsgBox "社員名を選択してください!", vbOKOnly Me.txtComboBox1.SetFocus Exit Sub End If rc = MsgBox("件数を入力しますか?", vbYesNo) If rc = vbYes Then MsgBox "実行する" Else MsgBox "中止しました" Exit Sub End If retu = Cells(3, Columns.Count).End(xlToLeft).Column + 1 Cells(3, retu).Value = Me.txtComboBox1.Value ←社員を選択 Cells(4, retu).Value = Me.txtsuzuki.Value  ←売れた件数 Cells(5, retu).Value = Me.txttoyota.Value  ←売れた件数 Cells(6, retu).Value = Me.txthonnda.Value   ←売れた件数 For Each Ctrl In Me.Controls If Ctrl.Name Like "txt*" Then Ctrl.Value = "" End If Next Ctrl End Sub また、テキストボックスに数字だけ入力して、プルダウン選択してないとエラ~メッセージも出るようにしたいです...

  • マクロにおける条件文の作成の件

    以下の様に条件付きの計算式を作成しました。CommandButton3を押しても 計算しなかったり、TextBox3.Value > TextBox1 ではないときでもエラー メッセージが出ます。どこに欠点があるのか教えて下さい。 Private Sub CommandButton3_Click() Dim row As Integer If TextBox1.Value = Empty Then MsgBox ("Aが空欄です") Exit Sub End If If TextBox2.Value = Empty Then MsgBox ("Bが空欄です") Exit Sub End If If TextBox3.Value = Empty Then MsgBox ("Cが空欄です") Exit Sub End If If TextBox4.Value = Empty Then MsgBox ("Dが空欄です") Exit Sub End If If TextBox3.Value > TextBox1.Value Then MsgBox ("Cの値をAの値より小さくしましょう!") Exit Sub End If If TextBox4.Value > TextBox2.Value Then MsgBox ("Dの値をBの値より小さくしましょう!") Exit Sub End If TextBox5 = Round(TextBox1 * TextBox2 - (TextBox1 - TextBox3) * (TextBox2 - TextBox4) / 2, 0) End Sub

  • 以下のVBAについて

    Option Compare Database Option Explicit Private Sub バックアップ開始_Click() Dim strBaseName As String Dim strFileName As String If IsNull(Me.バックアップ日付) = True Or Len(Me.バックアップ日付) = 0 Then MsgBox "バックアップ日付をyyyymmdd形式で入力してください。", vbOKOnly + vbCritical, "" Me.バックアップ日付.SetFocus Exit Sub End If strBaseName = "C:\Data\在庫管理.mdb" strFileName = "C:\Backup\" & Format(Me.日付, "yyyymmdd") & "StockData.mdb" If Dir(strFileName) <> "" Then If MsgBox(strFileName & Chr(13) & "は存在します。" & Chr(13) & _ "上書しますか?", vbYesNo + vbQuestion, "") = vbNo Then Exit Sub End If End If On Error GoTo LBL_ERROR FileCopy strBaseName, strFileName MsgBox "バックアップが完了しました。", vbInformation, "" LBL_EXIT: Exit Sub LBL_ERROR: Resume LBL_EXIT End Sub 上記のVBAでバックアップを行いたいのですが、フォルダ等も設定しているの実行されません。上記の文に間違いがあるのでしょうか? ソフトはAccessです。

  • vba ユーザーフォームにて質問

    勉強のためにvbaにユーザーフォームを作っています。 画像のとおり青色が塗られている箇所に、ユーザーフォームで社員名、件数を 転記したいです。 ユーザーフォーム 社員名 件数 を入力したら範囲はC3からC15転記されます。 転記終わったら、D3からD15に転記。この作業をH列まで行いたいのですが、 C3の列以降転記できません。 お答えできる方いればよろしくお願いします。 Private Sub CommandButton1_Click() Dim rc As Long Dim retu As Long Dim Ctrl As Control If Me.txtComboBox1.Value = "" Then MsgBox "社員名を選択してください!", vbOKOnly Me.txtComboBox1.SetFocus Exit Sub End If rc = MsgBox("件数を入力しますか?", vbYesNo) If rc = vbYes Then MsgBox "実行する" Else MsgBox "中止しました" Exit Sub End If retu = Cells(2, Columns.Count).End(xlToLeft).Column + 1 Cells(3, retu).Value = Me.txtComboBox1.Value ←社員を選択 Cells(4, retu).Value = Me.txtsuzuki.Value  ←売れた件数 Cells(5, retu).Value = Me.txttoyota.Value  ←売れた件数 Cells(6, retu).Value = Me.txthonnda.Value   ←売れた件数 For Each Ctrl In Me.Controls If Ctrl.Name Like "txt*" Then Ctrl.Value = "" End If Next Ctrl End Sub

  • exel vba ワークシートデータを日付にしたい

    ワークシートからFIND関数でID検索し、生年月日の検索値をテキストボックスに表示します。 過去データがない場合は日付形式で入力を促すため、日付形式でない場合誕生日EXITでエラーメッセージを表示させます。 過去データがあった場合はワークシートからデータを表示するのですが、ワークシートの日付データが25897のような数値で表示されるのでエラーになります。 ワークシート自体には日付形式で入力されていても、フォームにVBAで値を引っ張ると数値になってしまいます。数値を日付データに戻して表示はどうすればよいでしょうか? ’IDを入力した後のBVAです。 ************************************************************************************************* Private Sub TextBoxID_Exit(ByVal Cancel As MSForms.ReturnBoolean) Dim FRange As Range If TextBoxID.Text = "" Then Exit Sub End If ID = TextBoxID.Text On Error GoTo ErrHdl Worksheets("data").Activate With ActiveSheet Set FRange = .Range("b2:b65536").Find(ID, LookIn:=xlValues, LookAt:=xlWhole) If FRange Is Nothing Then MsgBox "新規です" Exit Sub End If TextBoxシメイ.Value = FRange.Offset(0, 1).Value TextBox誕生日.Value = FRange.Offset(0, 2).Value sex = FRange.Offset(0, 3).Value If sex = "M" Then OptionButton男.Value = True Else OptionButton女.Value = True End If TextBox体重.SetFocus End With Exit Sub ErrHdl: MsgBox "エラー" & Err.Number & Chr(13) & Err.Description End Sub *********************************************************************************************** Private Sub TextBox誕生日_Exit(ByVal Cancel As MSForms.ReturnBoolean) If IsDate(TextBox誕生日.Text) = False Then MsgBox "日付型データで入力.ex:H10/5/5" TextBox誕生日.Value = "" Else Exit Sub End If End Sub

  • エクセル VBA OptionButtonからTextBox

    すいません! OptionButtonなら 下記の記述でエラー表示を 簡単にできるのですが これがOptionButtonではなく TextBoxならどのように変化したら 良いのでしょうか? すいません、教えて下さい! Private Sub 記録_Click() Dim i As Integer Dim Cnt As Integer Cnt = 0 For i = 1 To 6 Step 1 If Me.Controls("OptionButton" & i).Value Then Cnt = i Exit For End If Next i If Cnt = 0 Then MsgBox "選択されていません" Exit Sub End If If Me.Controls("Combobox" & Cnt).Value = "" Then MsgBox Me.Controls("OptionButton" & Cnt).Caption & " の内容が選択されていません" Exit Sub End If With 記入フォーム .TextBox5.Value = Me.Controls("OptionButton" & Cnt).Caption .TextBox6.Value = Me.Controls("Combobox" & Cnt).Value End With Unload Me End Sub

  • accessについて<BOFとEOFのいずれかがTUREになっているか・・・現在のレコードが必要です>

    Private Sub kensaku_Click() On Error GoTo Err_kensaku_Click Screen.PreviousControl.SetFocus Dim ss As String Dim rs As String Dim strSQL As String Dim rstType As ADODB.Recordset Set rstType = New ADODB.Recordset ss = text.text strSQL = "Select 見積日 From 見積 where 提出見積No ='" & ss & "'" rstType.Open strSQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic, adCmdText If ss = "" Then MsgBox ("提出見積Noを入力してください") ElseIf rstType.EOF = False Then While rstType.EOF = False rs = rstType.GetString MsgBox (rs) rstType.MoveNext Wend kikaiNo.Value = "222" Else MsgBox ("提出見積Noが存在しません") End If Exit_kensaku_Click: Exit Sub Err_kensaku_Click: MsgBox Err.Description Resume Exit_kensaku_Click End Sub 以上は書いた検索のコードですが、<BOFとEOFのいずれかがTUREになっているか、または現在のレコードが削除されています。要求された操作には、現在のレコードが必要です>というエラーが出てきます。問題がどうかよくわかりませんので、教えていただけませんか。

  • 複数条件で抽出後結果をフォームに表示する方法

    フォーム上で「客先名」と「納入日」を指定して、その指定したものだけを表示したいと思い、下記のURL参考にさせていただき、自分で必要と思われる箇所を変更してみたのですが、「コンパイルエラー:プロシージャの外では無効です」とでて、うまくいきません。 私の知識不足でどこがどう悪いのかわからないので、どうかお助けください。 参考URL:http://hatenachips.blog34.fc2.com/blog-entry-129.html ※「納入日」はたとえば「2013/05/01~2013/05/20」というふうに範囲指定したいです。 ※作ったテキストボックス名は txt客先名、min年月日、max年月日 で、 抽出したいフィールド名は「客先名」と「納入日」です。 ↓URLを参考に自分なりに書き換えてみたコード Private Sub cmdFilter_Click() Dim strFilter As String, strExp As String, aryOpe As Variant If Not IsDate(Me.min年月日) Then MsgBox "日付ではありません。" Me.min年月日.SetFocus Exit Sub End If If Not IsDate(Me.max年月日) Then MsgBox "日付ではありません。" Me.max年月日.SetFocus Exit Sub End If If Not IsNull(Me.txt客先名) Then strFilter = strFilter & " AND 客先名 Like '*" & Me.txt客先名 & "*'" End If If Not IsNull(Me.min年月日) Then strFilter = strFilter & " AND 納入日 >= #" & Nz(Me.min年月日) & "#" End If If Not IsNull(Me.max年月日) Then strFilter = strFilter & " AND 納入日 <= #" & Nz(Me.max年月日) & "#" End If Me.Filter = Mid(strFilter, 3) If strFilter = "" Then Me.FilterOn = False Else Me.FilterOn = True End If End Sub Private Sub cmdFilterOff_Click() Me.Filter = "" Me.FilterOn = False Me.txt客先名 = Null Me.min年月日 = Null Me.max年月日 = Null End Sub 以上、よろしくおねがいします。

専門家に質問してみよう