• ベストアンサー

EXCEL VBA---IsDate

お知恵をお貸し下さい。 VBAでフォームを作成し、テキストボックスに数字(日付)を入力 (入力→10/7, 表示→2005/10/07) それを、IsDateで日付かどうかチェックさせたいのですが 下記のコードでは、例えば10月35日と入力してもエラーになりません。 (入力→10/35, 表示→1935/10/01) 2005/10/35と入力すればエラーになってくれるのですが やはりこの方法しかないのでしょうか? もし、良い方法がありましたらお教え下さい。 よろしくお願いします。 ----------------------------------------------------------------- Sub Test() Dim Data As Variant Data = TextBox16.Text If IsDate(Data) Then TextBox16.Value = CDate(Data) Else MsgBox ("正しい日付を入力してください。") End if End sub -----------------------------------------------------------------

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

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんにちは。 私の場合、このようなやり方でやっています。ここでは、1945 年にしてみました。 ただ、IsDate と CDate とを、And 条件で行ったりすると、CDate 側で、実行時エラーになります。 If IsDate(Data) Then  If Year(CDate(Data)) > 1945 Then   TextBox16.Value = CDate(Data)  Else   MsgBox "正しく日付を入れなおしてください。"  End If Else  MsgBox "正しい日付を入力してください。" End If

fk_sap
質問者

お礼

Wendy02さん! こんにちは。 久しぶりにここに質問を書いたのですが やはりWendy02さんにお会いすることができ、本当にうれしく思います! Wendy02さんのお名前を拝見し、涙が出る思いです(大げさではありませんヨ!) いつものことながら、素早く的確なご回答本当にありがとうございます。 私のあの質問内容で、知りたいことも理解して頂き ありがとうございます! 早速、利用させて頂きます。 ありがとうございました!

その他の回答 (2)

  • laputart
  • ベストアンサー率34% (288/843)
回答No.3

下のVBA(2)を作成したのですが、その前にfk_sapさんの作成された モジュールをそのまま動かしてみましたが、期待通りエラーに なりました。よってIsDateは正しく機能していると思います。 失礼ですが、このモジュールを TextBox16_LostFocus()に組入れて テストをすると動作しましたが、別にマクロとして動かすと 1935/10/01などになります。どこが違うのか分りませんがTEXTボックスの PrivateSubとしてテストお願いします。 (1)正しく動きます。 Private Sub TextBox16_LostFocus() Dim Data As Variant Data = TextBox16.Text If IsDate(Data) Then TextBox1.Value = CDate(Data) Else MsgBox ("正しい日付を入力してください。") End If End Sub ----------------- (2)以下は別の検査方法 例えば次のようにして、YYY=年 MMM=月 DDD=日付を求めて 検証します。 Sub Test() Dim Data As Variant Dim DDD,MMM,YYY,OK as Integer Data = TextBox16.Text OK=0 If IsDate(Data) Then '日付のチェック YYY=Year(Data) MMM=Month(Data) DDD=Day(Data) If MMM>12 then OK=1 If DDD>31 then OK1 IF MMM=2 and DDD>28 then OK=1 IF (MMM=4 or MMM=6 or MMM=9 or MMM=11) and DDD>30 then OK=1 ' (本当はうるう年のチェックが必要なのですが、省略します) Else OK=1 End If If OK=0 then TextBox16.Value = CDate(Data) Else MsgBox ("正しい日付を入力してください。") End if End sub

fk_sap
質問者

お礼

laputartさん! 大作をありがとうございました。 少しの時間違いで、No.2さんが私の求めていた通りの回答を下さいましたので それを利用させて頂こうかと思っていたところに laputartさんのお答えを拝見しました。 まだ目を通させてもらっていないのですが わざわざ、色々と書いて下さいましたので、ゆっくり拝見させて頂き 今後の私の糧とさせて頂きます。 本当にありがとうございました。

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

Data = Format(Year(Date),"0000") & "/" & TextBox16.Text で強制的に今の年を設定するとかすればいいのでは? それとも年を入れる場合もあるのですか?

fk_sap
質問者

お礼

早速ご回答ありがとうございます! なるほど、教えて頂いた通りにすれば 10月35日だとエラーがかかりますよねー。 でも、そうなんです・・・ ほとんどは本年の日付なのですが、来年等の日付を入力する場合もあるんです・・・。 せっかく教えて頂いたのに、すみませんでした。 もしも(もしも!)、他にありましたらよろしくお願いします。

fk_sap
質問者

補足

mshr1962さん! 先程「他にも方法があれば」などど、調子のいいことを書きましたが No.2さんが、良い方法を教えて下さいましたので それを利用させて頂くことにしました。 ありがとうございました。

関連するQ&A

  • 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

  • Excel VBA テキストボックスに当日の日付

    Excel 2013において、VBAで入力フォームを作成中の初心者です。 入力フォームの中に日付の項目があり、テキストボックスに手入力しています。 そのテキストボックスに当日の日付を自動で表示させたく、ネットで調べ試しましたが、うまくいきません。 やりたいこととしては、テキストボックスに今日の日付を自動的に和暦で表示させ、その日付を変更する場合には、「2016-12-03」などと入力後、和暦に自動的に変換して表示させたいのです。 手入力において、「2016-12-03」と入力後、自動的に和暦に変換するコードはネットで見つけることができ、うまくいったのですが、当日の日付を自動的に表示させる方法がわからずにおります。 日付を手入力後、和暦で表示させるコードは以下のようにしてあります。 Private Sub textbox1_AfterUpdate() With Me.textbox1 If IsDate(.Value) Then .Value = Format(.Value, "ggge年m月d日") End If End With End Sub どなたか、教えていただけると助かります。 よろしくお願いいたします。

  • エクセル VBAのチェックボックスについて

    お読みくださり、ありがとうございます。 エクセル初心者でございます。 エクセルのマクロなのですが、 お詳しい方、是非教えて欲しいです!汗 調子に乗って入力フォームなるものを作りました。 入力フォームの中にて、チェックボックスで「ある」「なし」の項目を入れてみたのですが、チェックしていないのに、値が入る現象が起きています汗 以下、素人が書いたコードを恥を承知で記載させていただきます。 Private Sub CheckBox1_Click() If CheckBox1.Value = True Then OK = "○" End If End Sub Private Sub CheckBox2_Click() If CheckBox2.Value = True Then NO = "×" End If End Sub Private Sub UserForm_Click() End Sub '以下のコードは、登録ボタンがクリックされたときの処理! Private Sub 登録ボタン_Click() If TextBox1.Text = "" Then MsgBox "グッズ名を入力してください。" Exit Sub End If If TextBox2.Text = "" Then MsgBox "アプローチ先を入力してください。" Exit Sub End If With Worksheets("協賛グッズ") With Cells(Rows.Count, 2).End(xlUp) .Offset(1, 0).Value = TextBox1.Text .Offset(1, 1).Value = mori .Offset(1, 2).Value = mori2 .Offset(1, 3).Value = TextBox2.Text .Offset(1, 5).Value = TextBox3.Text .Offset(1, 6).Value = TextBox4.Text .Offset(1, 7).Value = TextBox5.Text .Offset(1, 8).Value = TextBox6.Text End With End With TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" TextBox5.Text = "" TextBox6.Text = "" CheckBox1.Value = False CheckBox2.Value = False End Sub 以上です。 おかしなところ満載かと思いますが、 チェックを入れた項目だけ値を入れたいと考えております。 おわかりになるかたおりましたら何卒お助けください汗 よろしくお願いいたします。

  • EXCEL VBAで・・・。

    テキストボックス34に入力した値を、ExcelのA列の値より検索し その隣の値をテキストボックス4に表示させる、と言う処理をしています。 検索時に検索データが見当たらない場合、メッセージボックスを表示し、 更に、テキストボックス34のデータを消去→テキストボックス34にフォーカス移動 させたいのです。 下記のコードですと、メッセージボックス表示と テキストボックス34のデータ消去までは出来るのですが フォーカス移動してくれません。 イベントをexitにしている理由は特にないのですが、changeを使うと、 テキストボックス34に1文字入力された時点でメッセージボックスが表示されたり、 1文字でも一致するデータが順に表示されてしまいます。 (テキストボックス34に入力するデータの文字数は3文字固定です。) 何か良いお知恵がありましたら、お教え下さい。 ----------------------------------------------------------- Private Sub Textbox34_exit(ByVal Cancel As MSForms.ReturnBoolean) Dim Result As Variant Set Result = Range("A:A").Find(what:=TextBox34.Text, MatchCase:=True, matchbyte:=True) If Result Is Nothing Then MsgBox ("入力されたコードは登録されていません。") TextBox34.Text = "" TextBox34.SetFocus Else Range("A:A").Find(what:=TextBox34.Text, MatchCase:=True, matchbyte:=True).Activate ActiveCell.Offset(0, 1).Select TextBox4.Text = ActiveCell.Value End If End Sub

  • 年齢の計算について

    いろいろ調べましたが、なかなか分からないので質問させていただきます。 エクセルのVBAでユーザーフォーム内にテキストボックスを3つ配置しました。 それぞれのテキストボックスは以下のようにしています。 テキストボックス1 基準日の入力 (2012/4/1 など) テキストボックス2 生年月日の入力 (1980/5/10 など) テキストボックス3 基準日での年齢を表示(自動表示) テキストボックス1、2に日付を入力した場合にテキストボックス3に年齢が自動で表示される といった内容です。 そこで、以下のようにプログラムしましたが、基準日を過ぎた日付をテキストボックスに入力して しまった場合にエラーになって止まってしまいます。 そこで、テキストボックス2にテキストボックス1の基準日を過ぎた日付を入れてしまったときに エラーメッセージがでるようにしたいのですが、どうすればよいでしょうか? また、文字などを入れてしまった場合には、エラーメッセージが出ますが、和暦(例:60/4/10) など入れてしまった場合にもエラーになり止まってしまいます。 このような場合(yyyy/mm/dd以外の入力の場合)にもエラーメッセージが出るようにするには どうすればよいでしょうか? Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) If TextBox2 = "" Then Exit Sub Else If Not (IsDate(Me.TextBox2)) Then MsgBox "日付を入力してください" & Chr(10) & "例(2002/4/1)", vbCritical TextBox2 = "" Cancel = True Exit Sub Else TextBox3.Value = Evaluate("datedif(""" & TextBox2.Value & """,""" & TextBox1.Value & """,""y"")") End If End If End Sub 何卒よろしくお願いします。

  • Excel VBA テキストボックスを検索

    テキストボックス3に数値を入力し ExcelのA列にあるか検索をかける。 ある場合は、B列の同じ行に 「みーつけた!」と入力。 その設定で組んでみたのですが、 テキストボックス3にデータを6桁入力しようとすると 6桁目にオーバーフローエラーが出ます。 このプログラムの何処がおかしいのでしょうか? Private Sub TextBox3_Change() Dim Number As Integer If TextBox3.Value <> "" Then '空じゃない場合 Number = TextBox3.Value Call 検索(Number) MsgBox TextBox3.Value End If End Sub Sub 検索(ByVal Number As Variant) Dim FoundCell As Range Set FoundCell = Range("A:A").Cells.Find(What:=Number, lookat:=xlPart) If FoundCell Is Nothing Then Else FoundCell.Activate Range("O" & ActiveCell.Row).Value = "みーつけた!" End If End Sub

  • エクセルVBAでお願いします。

    エクセル2002使用です。 セルA1に 日付型で2004/9/25と間違いなく入っています。 その条件で下記のようにコードを打ちました。 Sub test() If Day(Range("A1")) = 30 Then MsgBox "yes" End If End Sub 25=30ならばmsgboxを表示なので、上記の例では表示してはいけないのに表示されます。 ちなみに=を<>不等号にしてもMsgboxが開きます。 おそらく型の問題だと思ったのですが、DAY関数はVariant型のintergerなので問題ないと思うのですが、理由がわかりません。 よろしくお願いします。

  • エクセル VBA ID入力について

    TextBox2に数字をIDを入力して 名前をComboBox1.Text に表示させるようにしました。 しかし、数字入力すると認識される物もあるのですが 表示されない=数字の値は同じ数字 なぜなのでしょうか? Private Sub TextBox2_Change() Dim vRet As Variant vRet = Application.VLookup(TextBox2.Text, _ Sheets("マスタ").Range("A:B"), _ 2, _ False) If VarType(vRet) <> vbError Then ComboBox1.Text = vRet Else ComboBox1.Text = "<< 該当なし >>" End If End Sub Private Sub UserForm_Initialize() With TextBox2 .SetFocus .Text = "ID入力"  .SelLength = Len(.Text) End With 教えて下さい!Sheet2の数字の書式が問題なのでしょうか?

  • エクセルVBAについて質問です。

    エクセルVBAについて質問です。 ユーザーフォームのテキストボックスに数字以外を入力するとエラーメッセージが出るように関数を作ったのですが、 Private Function AA(objtextbox As MSForms.TextBox) As Boolean Dim A As String AA = False A = Trim(objtextbox.Text) If objtextbox.Text <> "" Then If IsNumeric(A) = False Then MsgBox "数値 Error", vbCritical With objtextbox .SetFocus .SelStart = 0 .SelLength = Len(.Value) End With AA = True End If End If End Function Private Sub textbox1_exit(ByVal cancel As MSForms.ReturnBoolean) cancel = AA(TextBox1) End Sub テキストボックス200近くある場合、1つ1つに Private Sub textbox1_exit(ByVal cancel As MSForms.ReturnBoolean) cancel = AA(TextBox1) End Sub と作っていかなくてはいけないのでしょうか? プロシージャ名に変数使おうとしたら上手くできませんでした。 どなたか助けてください。

  • エクセル2003のVBAで、ユーザーフォームにあるテキストボックスに入力制限をつけたいのですが

    エクセル2003のVBAで、ユーザーフォーム上にあるテキストボックスに入力制限をつけようとしています。 エクセルのセル13列目にdeg値 0 0.5 1 1.5 2 ・ ・ ・ があります。 ここにない値を入力するとエラーメッセージを表示させます。 下記のコードで、小数点を入力した瞬間(例えば「1.」)にエラーメッセージが表示されてしまいます。 どう修正したらよいか、どなたか分かりませんでしょうか? よろしくお願いいたします。 Private Sub TextBox21_Change() For i = 7 To 1446 If TextBox21.Value = ThisWorkbook.Sheets(\"default\").Cells(i, 13).Value Then Exit For Next i If i = 1447 Then MsgBox \"deg値と一致しません。補正値を入れなおしてください。\" TextBox21.Text = \"\" End If End Sub

専門家に質問してみよう