• 締切済み

日付の重複した場合にエラー表示をさせたい。

以下の記述の場合、日付の重複をしてもエラーが出ません。 文字の重複はちゃんと、エラーがでました。 どのように書き換えたら、日付の重複に対してエラーが出るのか教えていただきたいです。 On Error Resume Next check = 0 check = WorksheetFunction.Match(TextBox8.Text, Range("業務報告書データ2").Columns(1), 0) On Error GoTo 0 If check > 0 Then MsgBox "この日付は、すでに入力されています。", vbExclamation, "入力エラー" TextBox8.SetFocus Exit Sub End If

みんなの回答

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

こんばんは。 そのご質問ですと、ちょっと回答側は厳しいですね。 UserForm をお使いになっているのでしょうか?コントロールツールなのでしょうか? それから、 Range("業務報告書データ2").Columns(1) と、名前登録しておいて、その一列目なのでしょうか?ずいぶん、凝った造りなのですが、単に、列数でかまわないのではないでしょうか?それとも、領域は、可変なのでしょうか? 別に、ワークシート関数を使おうが、それ自体は問題ないのですが、まず、TextBox で正しく日付が入れられているかどうか、シリアル値を検索するときに重要になってしまいます。 なお、Match 関数は、内部で数値検索(Value2)しています。 Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)   Dim myDate As Variant   Dim Ret As Long   If KeyCode <> 13 Then Exit Sub   myDate = TextBox8.Text   If IsDate(myDate) Then     myDate = CLng(CDate(myDate))     On Error Resume Next     Ret = 0     Ret = WorksheetFunction.Match(myDate, Range("業務報告書データ2").Columns(1), 0)     On Error GoTo 0     If Ret > 0 Then       MsgBox "この日付 " & Format$(myDate, "yy/MM/dd") & " は、すでに入力されています。", vbExclamation, "入力エラー"       KeyCode = 0     Else      '別の作業     End If   End If End Sub

kennpon
質問者

お礼

ありがとうございました。 問題解決です。

全文を見る
すると、全ての回答が全文表示されます。
  • zap35
  • ベストアンサー率44% (1383/3079)
回答No.1

TextBox8.Textは文字列を返します。でも日付(型のデータ)はEXCEL内部ではシリアル値です(セルの書式を「標準」にしたときに表示される値) 見かけは同じ 2007/6/9 であっても、全く異なる値ですからMATCH関数では検索できません。 CDate(TextBox8.Text) で日付型に変換してやれば検索に引っかかると思います。無論テキストボックスにはEXCELが「日付」と認識できる形式で文字を入力する必要があります。 ただしEXCELではMATCH関数で日付を検索するときクセがありますので、一旦 CDate(TextBox8.Text) をどこかのセル(仮にAA1)に書き込み、 check = WorksheetFunction.Match(Range("AA1").Value, Range("業務報告書データ2").Columns(1), 0) のようにする方がうまくいくと思います。

kennpon
質問者

補足

ありがとうございます。 テキストボックスに入力した日付を、いったんセルに(a5)にも表示してみて、以下の様にしてみました。 エラー表示でませんでした。 On Error Resume Next check = 0 check = WorksheetFunction.Match(Range("A5").Value, Range("業務報告書データ2").Columns(1), 0) On Error GoTo 0 If check > 0 Then MsgBox "この日付は、すでに入力されています。", vbExclamation, "入力エラー" TextBox8.SetFocus Exit Sub End If

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • 入力時エラーメッセージの出し方

    http://oshiete1.goo.ne.jp/qa3745129.htmlを参考に 下記の構文を作りましたが、エラーメッセージが出せなく困っています。 フォームで入力を行う際に、該当ボックスで車番一覧にデータの無いものに関してエラーメッセージを出したいと考えています。 修正箇所に関してご指摘いただければと思います。 よろしくお願いします。 Private Sub CommandButton1_Click() Dim check As Long '重複の有無(=0:重複せず,>0:重複) With Cells(Rows.Count, 1).End(xlUp).Offset(1) .Value = TextBox1.Text .Offset(0, 1).Value = TextBox2.Text .Offset(0, 2).Value = TextBox3.Text .Offset(0, 4).Value = TextBox4.Text On Error Resume Next check = 0 check = WorksheetFunction.Match(CInt(TextBox2.Text), Range("車番一覧", Columns(1))) On Error GoTo 0 If check = 0 Then MsgBox "その車番は登録されていません!", vbExclamation, "入力エラー" TextBox2.SetFocus Exit Sub End If Exit Sub End With TextBox1.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" If TextBox1.Text = "" Then TextBox1.SetFocus End If Range("A1").Sort Key1:=Range("A1"), order1:=xlAscending, Key2:=Range("A1"), order2:=xlAscending, Header:=xlGuess End Sub

  • [コンパイルエラー 修飾子が不正です]

    ユーザフォームに「ユーザ名」を入力します。  (1)テキストボックスの入力有無の確認  (2)ユーザ名の重複の確認 上記を実行させようとしているのですが、「コンパイルエラー 修飾子が不正です」が表示 されてしまいます。 にわか覚えのVBAでどうしたらよいか・・わかりません。 ご教授願います。。m(__)m。。 **********以下 '[登録ボタン]を押した時の処理 Private Sub user_touroku_button_Click()   ←★ここでエラー発生!! '------------------------------------------------- Dim check As Long '重複有無 Dim rowsCount As Long '表の現在行数 '必須項目のチェック(ユーザ名) If user_txt.Text = "" Then MsgBox "ユーザ(案件)名を入力してください。", vbExclamation, "入力エラー" user_txt.Text.SetFocus Exit Sub End If 'ユーザ名の重複チェック On Error Resume Next check = 0 check = WorksheetFunction.Match(user_txt.Text, Range("ユーザ一覧").Columns(5), 0) On Error GoTo 0 If check > 0 Then MsgBox "このユーザ(案件)名はすでに登録されています", vbExclamation, "重複エラー" user_txt.Text.SetFocus Exit Sub End If '----------------------------------------------------- よろしくお願いします。

  • エクセル

    下記のようなマクロを作成しましたが、実行するとエラーメッセージ(コンパイルエラー SubまたはFunctionが定義されていません)が表示され止ってしまいます。 解決方法を御指導お願い致します。 Private Sub CommandButton2_Click() '得意先登録ダイアログで登録ボタンをクリック時実行 Dim check As Long '重複の有無(=0:重複せず,>0:重複) Dim insertRow As Long '挿入行位置 '入力必須項目のチェック If koudo.Text = "" Then MsgBox MsgBox "得意先コードを入力してください", vbExclamation, "入力エラー" koudo.SetFocus Exit Sub End If If syamei.Text = "" Then MsgBox "得意先名を入力してください", vbExclamation, "入力エラー" syamei.SetFocus Exit Sub End If '重複チェック On Error Resume Next check = 0 check = WorksheetFunction.Match(clnt(koudo.Text), Range("得意先一覧").Columns(2), 0) On Error GoTo 0 If check > 0 Then MsgBox "この得意先コードは、すでに入力されています", vbExclamation, "入力エラー" koudo.SetFocus Exit Sub End If Sheets("得意先マスター").Unprotect With Range("得意先一覧") '最下行に一行挿入する insertRow = .Rows.Count .Rows(insertRow).Insert Shift:=xlDown 'データをセルに入力する .Cells(insertRow, 1) = tourokubi.Text .Cells(insertRow, 2) = koudo.Text .Cells(insertRow, 3) = syamei.Text .Cells(insertRow, 4) = huri.Text End With Sheets("得意先マスター").Protect Unload 得意先登録ダイアログ End Sub

  • 日付のエラー

    aspx(vbscript)でプログラムを作っています。 ある申請書を作っているのですが、その中で テキストボックスに日付を入力して、その日付が[今日]より 前だとエラーになるというコードを作りたいのですが、 If Trim(textbox1.value) <>"" and Datevalue(textbox1.value) < Date Then msgbox "日付が違います。" End If としたのですが、テキストボックスに何も入力しないとエラーになって動いてくれません。テキストボックスに入力すればちゃんと動きます。 この項目は必須項目ではないのでテキストボックスに入力せずに申請する場合もあるので困っています。どのようにすればちゃんと動作してくれるのでしょうか。  

  • ユーザーフォーム データ消去の時の処理

    環境:Excel2002です ユーザーフォームのテキストボックスの入力チェックをしています Rem**************** Rem TextBox5 Check Rem**************** Private Sub TextBox5_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If Len(Me.TextBox5.Text) = 0 Then '未入力Check If IsNumeric(Me.TextBox5.Text) = False Then '数値入力Check MsgBox "数値で入力してください", _ vbExclamation, "納品書作成ツール" Me.TextBox5.SetFocus Exit Sub End If MsgBox "入力してください", _ vbExclamation, "納品書作成ツール" Me.TextBox5.SetFocus Exit Sub End If Me.TextBox5.Text = Format(Me.TextBox5.Text, "#,##0") End Sub 入力したデータを消去して Enterキーを押すか、マウスでクリックした時のいずれでも Len(Me.TextBox5.Text) = 0 と認知されて "数値で入力してください"のメッセージが表示されてしまいます このメッセージが出ないようにするにはどうしたらいいのでしょうか ご教示願います

  • VBAの日付チェックでオーバーフローを回避したい。

    VBAの日付チェックでオーバーフローを回避したい。 ExcelのG列のセルに入力されたものが日付型であるかどうかのチェックかけたいと思います。 以下のコードだと、数字2958466以上の入力でオーバーフローが発生します。 これを回避する方法はありますか? セルを日付型に設定しているため、2958465(2999/12/31)までしか判別できないのでしょうが、 利用者が2958466以上を入力してしまう可能性はあります。 オーバーフローではなく、エラーメッセージが出せたら・・・と思います。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 8 Then Application.EnableEvents = False If Target <> "" And Not IsDate(Target) Then MsgBox "日付型で入力してください。" & vbCrLf & "(例:2010/10/31)", vbCritical, "入力エラー" Target = "" Target.Select End If Application.EnableEvents = True End If End Sub こんなコードも試しましたが、結果は同じでした。 ↓ Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 8 Then Application.EnableEvents = False If Target > 2958466 Then MsgBox "日付型で入力してください。" & vbCrLf & "(例:2010/10/31)", vbCritical, "入力エラー" Target = "" Target.Select Else If Target <> "" And Not IsDate(Target) Then MsgBox "日付型で入力してください。" & vbCrLf & "(例:2010/10/31)", vbCritical, "入力エラー" Target = "" Target.Select End If End If Application.EnableEvents = True End If End Sub On Error Resume Next や On Error GoTo ... での対処も考えましたが、同じ結果でした。 何か良い方法がありましたら、お願いいたします。

  • 間違った入力をした時、もう一度入力させる場合

    以前、 "textBox1に品番を入れたら、Label1に品名を表示させています。 このとき、TextBox1に存在しない品番を入力した場合は、 再度入れなおしをさせたいのです。" における質問と回答(-yellowtail-&e10go) を参照して textbox1の文字数が8文字以外のときは、もう一度textbox1に戻って来るように、次のように入力しました。 Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) If Len(TextBox1) <> 8 Then MsgBox ("正しい日付を入力してください。") Cancel = True TextBox1.SetFocus(この行は、うまく行かないので、勝手につけてみましたが、うまく行きませんでした) Exit Sub End If End Sub しかしながら、うまくtextbox1に戻ってくれません。 また、この入力のためのuserformを消す際にも、 MsgBox ("正しい日付を入力してください。") が表示されてしまいます。 2つの点で困っています。 どのように改良したら良いでしょうか? すいませんが、よろしくお願いいたします。

  • Excel ユーザーフォーム呼び出し時エラー

    WindowsVista HomePremium Excel 2007 Microsoft Visual Basic 6.5 です。 Excelでユーザーフォーム(UserForm1)を作り、   Sub Auto_Open()     UserForm1.Show   End Sub で起動時に呼び出すようにしました。 確認のため、一度Excelを閉じ起動し直したところ正常に動作しました。 もう一度確認のため同じように再起動をすると、  実行時エラー '2110': コントロールが表示されていない、利用できない、またはフォーカスを持てないため、そのコントロールにフォーカスを移すことはできません。 と出て、それ以降何度やっても動作しなくなってしまいました。 解決法か原因がわかる方いらっしゃいましたら、ぜひご教授ください。よろしくおねがいします。 ユーザーフォーム関係のコードを以下に書いておきます。(内容は小遣い帳のようなものです。) ―――――――――――――――――――― Private Sub CommandButton1_Click() Dim NUM As Integer If TextBox1.Text = "" Then MsgBox "概要が記入されていません。" TextBox1.SetFocus GoTo 100 ElseIf TextBox2.Text = "" Then MsgBox "収支が記入されていません。" TextBox2.SetFocus GoTo 100 ElseIf ComboBox1.ListIndex = -1 Then MsgBox "収支の種類が選択されていません。" ComboBox1.SetFocus GoTo 100 End If Range("F6").Select NUM = 0 Do While ActiveCell.Offset(NUM, 0) <> "" NUM = NUM + 1 Loop ActiveCell.Offset(NUM, 0).Select ActiveCell = TextBox1.Value If CheckBox1 = True Then TextBox2 = -TextBox2 End If If ComboBox1.ListIndex = 0 Or ComboBox1.ListIndex = 1 Then ActiveCell.Offset(0, ComboBox1.ListIndex + 1) = TextBox2.Value Else ActiveCell.Offset(0, ComboBox1.ListIndex + 2) = TextBox2.Value End If TextBox1 = "" TextBox2 = "" CheckBox = Falses ComboBox1.ListIndex = -1 100 End Sub ―――――――――――――――――――― Private Sub CommandButton2_Click() Dim NUM As Integer If TextBox3.Text = "" Then MsgBox "移動金額が記入されていません。" TextBox3.SetFocus GoTo 100 ElseIf ComboBox2.Text = "" Then MsgBox "移動元が選択されていません。" ComboBox2.SetFocus GoTo 100 ElseIf ComboBox3.ListIndex = -1 Then MsgBox "移動先が選択されていません。" ComboBox3.SetFocus GoTo 100 End If Range("F6").Select NUM = 0 Do While ActiveCell.Offset(NUM, 0) <> "" NUM = NUM + 1 Loop ActiveCell.Offset(NUM, 0).Select ActiveCell = "移動" If ComboBox2.ListIndex = 0 Or ComboBox2.ListIndex = 1 Then ActiveCell.Offset(0, ComboBox2.ListIndex + 1) = -TextBox3.Value Else ActiveCell.Offset(0, ComboBox2.ListIndex + 2) = -TextBox3.Value End If If ComboBox3.ListIndex = 0 Or ComboBox3.ListIndex = 1 Then ActiveCell.Offset(0, ComboBox3.ListIndex + 1) = TextBox3.Value Else ActiveCell.Offset(0, ComboBox3.ListIndex + 2) = TextBox3.Value End If TextBox3 = "" ComboBox2.ListIndex = -1 ComboBox3.ListIndex = -1 100 End Sub ―――――――――――――――――――― Private Sub CommandButton3_Click() Unload Me End Sub ―――――――――――――――――――― Private Sub CommandButton4_Click() Unload Me End Sub ―――――――――――――――――――― Private Sub UserForm_Initialize() myarray1 = Array("収支", "クレジット", "郵便局", "机", "500", "1") For i = 0 To 5 ComboBox1.AddItem myarray1(i) ComboBox2.AddItem myarray1(i) ComboBox3.AddItem myarray1(i) Next i TextBox1.SetFocus 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

  • ACCESSの重複チェックについて

    顧客データをACCESS2003にて作成しています。 フォームにてVBAを用いて重複チェックをしているのですが、件数が多いせいかチェックに時間が掛かっております。(入力済件数は10万は超えております。) テーブル(T_顧客管理)よりチェック出来るようにしており、チェックのフィールドは「住所」にしております。 Private Sub 住所_BeforeUpdate(Cancel As Integer) If DCount("住所", "T_顧客管理", _ "住所='" & Me!住所 & "'") > 0 Then Beep MsgBox "既存のデータと同じ住所が入力されました! " & _ "別の値を入力してください。", _ vbOKOnly + vbExclamation, "重複エラー" Cancel = True Me.Undo End If End Sub 上記の式を入れておりますが、別の方法(式)にて上記と同じ内容にてチェック出来る式があれば教えていただきたいと思いますので、宜しくお願い致します。

専門家に質問してみよう