• 締切済み

VBA FIND時のIFの使い方について

VBA素人です。教えてください。 添付シートのようなデータがあるとします。 ユーザーフォームにテキストボックスを作成し、 (1)シート内の型式を型式BOXに手入力で入れる (2)良品数を手入力で入れる (3)日付を手入力で入れる(初期設定はDateをかえす) (1)~(3)を入力し、入力コマンドボタンで型式と日付がFINDするセルに 良品数を入れるコードを下記作成しました。 シート内に対象の型式、日付があれば、うまく作動するのですが、 型式、日付両方が無い場合、もしくはどちらか片方が無い場合は、 うまく作動しません。 おそらく型式FIND~IF、日付FIND~IFの使い方が悪いと思います。 型式がシート内に無ければ、型式エラーとしマクロを抜ける。 型式があり、日付が無ければ、日付エラーでマクロを抜けるコードを教えてください。 なお、型式を手入力で入れていますが、シート内の("B:B")セルを選択すると自動で型式テキストボックスに入れる方法もご教示下さい。 Private Sub UserForm_Initialize() 型式BOX = ""'テキストボックス 良品BOX = ""'テキストボックス 日付BOX = Date'テキストボックス 型式BOX.SetFocus End Sub Private Sub 入力_Click() Application.ScreenUpdating = False Application.EnableEvents = False If Len(型式BOX.Value) = 0 Then MsgBox "型式が未選定です" Cancel = True ElseIf Len(良品BOX.Value) = 0 Then MsgBox "良品が未入力です" Cancel = True ElseIf Len(日付BOX.Value) = 0 Then MsgBox "日付が未入力です" Cancel = True Else Dim a As Variant a = 型式BOX.Value Dim b As Date b = 日付BOX.Value On Error Resume Next Columns("B:B").Select ActiveSheet.Cells.Find(a, , , xlWhole, xlByRows, xlNext, False).Select X = ActiveCell.Row If Err = 91 Then MsgBox (prompt) & a & "の型式はありません", _ (vbOKOnly + vbExclamation), ("型式検索結果") Err.Clear End If On Error Resume Next Rows("1:1").Select ActiveSheet.Cells.Find(b, , , xlWhole, xlByColumns, xlNext, False).Select Y = ActiveCell.Column If Err = 91 Then MsgBox (prompt) & b & "の日付はありません", _ (vbOKOnly + vbExclamation), ("日付検索結果") Err.Clear   End If Cells(X, Y) = 良品BOX.Value End If End Sub

みんなの回答

  • hige_082
  • ベストアンサー率50% (379/747)
回答No.2

>なお、現在型式を手入力で入れていますが、 >シート内の("B:B")セルを選択すると >自動で型式テキストボックスに入れる方法もご教示下さい。 excel97の使用を考えているのならば excel97はモードレスに対応していないので、以下の方法しかないよ userformを表示する前にセルを選択しておいたものを 表示時にtextboxへ入力する 'userformモジュールへ Private Sub UserForm_Initialize() If ActiveCell.Column = 2 Then 型式BOX = ActiveCell.Value 'テキストボックス Else 型式BOX = "" 'テキストボックス End If 良品BOX = "" 'テキストボックス 日付BOX = Date 'テキストボックス 型式BOX.SetFocus End Sub 以上 参考まで

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

検証はしてませんが、こんな感じで Private Sub 入力_Click() Application.ScreenUpdating = False 'Application.EnableEvents = False If 型式BOX.Value = "" Then MsgBox "型式が未選定です": Exit Sub If 良品BOX.Value = "" Then MsgBox "良品が未入力です": Exit Sub If 日付BOX.Value = "" Then MsgBox "日付が未入力です": Exit Sub On Error Resume Next x = ActiveSheet.Columns("B:B").Find(型式BOX.Value, , , xlWhole, xlByRows, xlNext, False).Row If x = "" Then MsgBox (prompt) & 型式BOX.Value & "の型式はありません", _ (vbOKOnly + vbExclamation), ("型式検索結果") Exit Sub End If y = ActiveSheet.Rows("1:1").Find(CDate(日付BOX.Value), , , xlWhole, xlByColumns, xlNext, False).Column If y = "" Then MsgBox (prompt) & 日付BOX.Value & "の日付はありません", _ (vbOKOnly + vbExclamation), ("日付検索結果") Exit Sub End If ActiveSheet.Cells(x, y) = 良品BOX.Value End Sub 参考まで

nkgw_4a_t
質問者

補足

遅くなりました。 うまく動作しそうです。 なお、現在型式を手入力で入れていますが、 シート内の("B:B")セルを選択すると 自動で型式テキストボックスに入れる方法もご教示下さい。 よろしくお願いいたします。

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

関連する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

  • IF文の分岐が正しく動きません

    Access VBAについて教えてください。いまオプショングループの中にテキストボックスがあります。オプショングループをoption1、テキストボックスをtextbox1とします。テキストボックスは空の状態で、ロックをかけているので入力はできません。 実行ボタンを押したときに、テキストボックスの中が空ならMsgboxをだしなさいという文をかきました。 If txtbox1.value = "" Then msgbox "nothing" end if また .value=NULL とも書き換えて実行しましたが、なぜかmsgboxを表示せずにend ifにいってしまいます。何が原因と考えられるでしょうか?

  • マクロFind検索で見つからなかった時の対処

    エクセル2013です 以下のコードを作成しましたが .Rowが色で塗られ 「型が違います」でERRになります。 .Columnの方はERRでなく なぜ.Rowの方がERRなのでしょうか? よろしくお願いします。 Dim 検索行番号 As Range Dim 判定列番号 As Range Dim 検索列番号1 As Range Dim 検索列番号2 As Range Set 検索行番号 = Rows(1).Find("みかん").Column If 検索行番号 Is Nothing Then MsgBox "みかんが有りません。" End If Exit Sub Set 判定列番号 = Rows(1).Find("りんご").Column If 判定列番号 Is Nothing Then MsgBox "りんごが有りません。" End If Exit Sub Set 検索列番号1 = Range("B:B").Find("大箱").Row If 検索列番号1 Is Nothing Then MsgBox "大箱が有りません。" End If Exit Sub Set 検索列番号2 = Range("B:B").Find("小箱").Row If 検索列番号2 Is Nothing Then MsgBox "小箱が有りません。" End If Exit Sub

  • EXCEL2007 VBA IF文について

    プログラム If Sheets("sheet1").Cells(85, 1).Value = Cells(13, 1).Value Then msgBox "true" Else msgBox"false" End If 値 Sheets("sheet1").Cells(85, 1).Value ← 0.38125 Cells(13, 1).Value ← 0.38125 上記のプログラムと値のとき、結果はtrueが表示されると思うのですが、なぜかfalseが表示されてしまいます。なぜ、falseが表示されるのか解りましたら教えてください。 値はウォッチで確認しています。

  • エクセル 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---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 -----------------------------------------------------------------

  • 日付のエラー

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

  • エクセル IF について!

    UserForm上にTextBoxとコマンドボタンがあり、TextBoxに数字を入れコマンドボタンをクリックすると'A.xlsをセットしてAシートの使用行を格納し検索して他のTextBoxにも反映させていくやり方でマクロを記述しています。そこでTextBoxに入力した数字がない場合はMsgBox”この数字はありません”という形にしたいのですが・・・どのようにすれば良いのか教えて下さい。 If Me.Controls("TextBox1" & Cnt).Value = "" Then MsgBox "呼出したい数字を入力して下さい" Exit Sub End If Set wbMyBook = Workbooks(ThisWorkbook.Name) If MsgBox("以前の記録を呼び戻しますか?", vbOKCancel) = vbOK Then Application.ScreenUpdating = False strMyBookPath = ThisWorkbook.Path If Dir(strMyBookPath & "\" & k1Name) <> "" Then 'あった場合そのブックが空いているか確認する。 flag = False For Each wb In Workbooks '開いていればTrue,開いていなければFalseを設定 If wb.Name = k1Name Then flag = True Exit For End If Next wb 'ブックが開いていなかった場合、ブックを開ける。 If flag = False Then Workbooks.Open strMyBookPath & "\" & k1Name End If Set k1 = Workbooks(k1Name) Set SH1 = k1.Worksheets("Sheet1") Else MsgBox WDName & "が存在していません。設置してください。", vbExclamation, "確認してください" Exit Sub End If lngYcnt_K = SH1.UsedRange.Rows.Count flag = False For lng = 1 To lngYcnt_K If CStr(TextBox1.Text) = CStr(SH1.Cells(lng, 1)) Then flag = True lngNumber = lng Exit For End If Next lng If flag = True Then TextBox3.Value = SH1.Cells(lngNumber, 2) '氏名 End If If SH1.Cells(lngNumber, 3) = "男" Then OptionButton1.Value = True ElseIf SH1.Cells(lngNumber, 3) = "女" Then OptionButton2.Value = True Else OptionButton1.Value = True OptionButton2.Value = False End If MsgBox " 記録を呼び戻しました" Else MsgBox"確認必要"⇒ここにもし数字が違っていたら表示させたいのですが・・・ End If MsgBox " 以前に記録しましたか?" Application.DisplayAlerts = False k1.Close saveChanges:=True Application.DisplayAlerts = True '-------------------------------------------------------------------------- '画面更新ON Application.ScreenUpdating = False End Sub

  • マクロ セル参照時の記述

    いつも回答ありがとうございます。 似たような質問をしていますが、下記の記述の(b3.value!"$B$1").の箇所でエラーがかかりました。 .SetSourceData Source:=Range(b3.value!"$B$1").CurrentRegion どのように変更したら上手く動作するのでしょうか?b3は変数です。御指導の程宜しくお願い致します。 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 'b1と違う列のセル番号 Dim d2 As Variant 'b2と違う列のセル番号 Dim d3 As Variant 'b3と違う列のセル番号 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 Worksheets.Add After:=Worksheets("集計用") ActiveSheet.Name = b3.Value .Activate .Range(b1, b2).Copy _ Destination:=Worksheets(b3.Value).Range("B2") .Activate .Range(Cells(d1, d3), Cells(d2, d3)).Copy _ Destination:=Worksheets(b3.Value).Range("C2") With Worksheets(b3.Value).Range("D2:D" & Range("C65536").End(xlUp).Row) .Formula = "=SUM(C2,D1)" .Value = .Value End With End With Charts.Add With ActiveChart .ChartType = xlColumnClustered .SetSourceData Source:=Range(b3.value!$B$1").CurrentRegion With .Axes(xlValue) .MaximumScale = 10 .MajorUnit = 1 End With .Location Where:=xlLocationAsObject, Name:=b3.Value End With End Sub

  • エクセルVBAで

    お世話になります。 エクセルVBAで簡易プログラムを作成しています。 その中でユーザーフォームを作り、チェックボックスで 6項目からどれか一つ選択する様な仕組みを作っています。 利用者が二つ以上選択(チェック)出来ない様にしたいの ですが、どの様にすれば良いでしょうか。 ちなみに今の記述は下記の様になります。 ご教授下さいます様、宜しくお願い致します。         記 If CheckBox1 = False Then If CheckBox2 = False Then If CheckBox3 = False Then If CheckBox4 = False Then If CheckBox5 = False Then If CheckBox6 = False Then MsgBox "どれか選択して下さい!" GoTo err_jmp Else: mytoki = "3年前から" End If Else: mytoki = "2年前から" End If Else: mytoki = "1年前から" End If Else: mytoki = "半年前から" End If Else: mytoki = "1週間前から" End If Else: mytoki = "昨日から" End If