VBAを勉強し始めたものです。以下のプログラムはネット上の皆様に教えて

このQ&Aのポイント
  • VBAを勉強し始めたものです。以下のプログラムはネット上の皆様に教えて頂きながら作成しております。
  • テキストボックスに入力された文字を含むセルに着色するプログラムがあります。
  • しかし、テキストボックスに文字未入力の段階でクリックしてもエラーメッセージが表示されない不具合が発生しています。
回答を見る
  • ベストアンサー

VBAを勉強し始めたものです。以下のプログラムはネット上の皆様に教えて

VBAを勉強し始めたものです。以下のプログラムはネット上の皆様に教えて頂きながら作成しております。教えていただいた方、感謝しています。 Dim myKey As String Dim maxrow As Long Dim maxcolumns As Long (1) If textbox1.Value = "" Then Exit Sub MsgBox "キーワードが未入力です", vbExclamation myKey = textbox1.Value maxrow = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row maxcolumns = Worksheets("sheet1").Cells(maxrow, Columns.Count).End(xlToRight).Columns Debug.Print maxrow Debug.Print maxcolumns If flag = False Then '初めての検索処理 Set c = Cells.Find(After:=Cells(Rows.Count, Columns.Count), What:=myKey, LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByColumns) c.Interior.ColorIndex = 4 '初めての結果(range)を保存しておく Set d = c flag = True Else '2回目以降の検索処理 Set d = Cells.Find(After:=d, What:=myKey, LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByColumns) d.Interior.ColorIndex = 4 '保存しておいた結果と今回の検索結果を比較して1周してきたと判断して終了を表示 If c.Address = d.Address Then MsgBox "検索終了" End If これはテキストボックスに入力された文字を含むセルに着色する、というものです。検索、着色部分は成功しています。ありがとうございます。 でも(1)の部分なのですが、なぜか、テキストボックスに文字未入力の段階でクリックすると、エラーメッセージがでません。でも文字を入力して、検索のボタンをクリックするたびに"キーワードが未入力です"の表示が出ます。現象としてはマッタク反対なのですが、なぜこうなるのか、プログラムのどこに問題があるのか、教えてください。よろしくお願いします。

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

  • ベストアンサー
  • ziziwa1130
  • ベストアンサー率21% (329/1547)
回答No.2

If textbox1.Value = "" Then Exit Sub MsgBox "キーワードが未入力です", vbExclamation これでは If textbox1.Value = "" がTrueの場合にはこのマクロの実行が終了してしまい、 If textbox1.Value = "" がFalseの場合には次のステートメント MsgBox "キーワードが未入力です", vbExclamation が実行されてしまいます。 次のように修正してみて下さい。 If textbox1.Value = "" Then MsgBox "キーワードが未入力です", vbExclamation Exit Sub

crtlcdpdpel
質問者

お礼

OKWAVEのビギナーなもので、ここにお礼が書けるとは知りませんでした。助かりました。ありがとうございます。まだVBAを勉強し始めたものです。本屋に行っても、基本ばかり書かれている本は山のようにありますが、イザこの機能はどうやって、となると殆ど役に立ちません。 そんなわけで、こんな機能はどうやって組むのか、と自問自答とコピペを繰り返しながら試行錯誤の毎日です。またネットで見かけたら質問に答えてやってください。よろしくお願いします。

その他の回答 (1)

  • Tofu-Yo
  • ベストアンサー率33% (36/106)
回答No.1

(1) If textbox1.Value = "" Then Exit Sub MsgBox "キーワードが未入力です", vbExclamation だとtextbox1.Value = ""であった場合にすぐsubを出てしまいます。 逆にtextbox1.Valueが""じゃないときにはこのif文が単にスルーされてMsgBoxを表示してしまいますね。次のようにしてみてください。 If textbox1.Value = "" Then   MsgBox "キーワードが未入力です", vbExclamation   Exit Sub End If textbox1.Value = "" であった場合にMsgBoxを表示してその後Subを出るという意味になります。

関連するQ&A

  • VBAを勉強し始めた者です。

    VBAを勉強し始めた者です。 Private Sub スタート_Click() Dim myKey As String Dim maxrow As Long myKey = 入力値.Value maxrow = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row If flag = False Then '初めての検索処理 (1) Set c = Worksheets("sheet1").Range(Cells(2, 1), Cells(maxrow, 1)).Find(What:=myKey, LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByRows) c.Interior.ColorIndex = 4 '初めての結果(range)を保存しておく Set d = c flag = True Else '2回目以降の検索処理 (2) Set d = Worksheets("sheet1").Range(Cells(2, 1), Cells(maxrow, 1)).Find(What:=myKey, LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByRows) d.Interior.ColorIndex = 4 '保存しておいた結果と今回の検索結果を比較して1周してきたと判断して終了を表示 If c.Address = d.Address Then MsgBox "検索終了" End If End Sub 現在データはA1がデータ名(名前、番号、住所など)、A2からA11までデータが入っています。テキストボックス(以下TB)に入力された文字を含むセルに着色する、というものです。検索、着色部分は成功しています。 これにB1にデータ名、さらにB2からB11まで新たにデータを加えました。 本来はA列だけ検索の対象にしたいのですが後で他の機能を追加するためB列にもデータを加えました。 たとえばテキストボックスに入力した文字を三とします。三を含むデータがA2、A11、B2、B11にあったとします。 上記のプログラムだと、なぜかA11だけ着色され、終了します。本来はA2から下に向かって検索してほしいのですが。 試行錯誤した中には、B2→A11の二つのセルだけ、TBに入力された文字が含まれるセルに着色していきました。 11行以降もデータが増えることを想定して、 maxrow = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row で最終行を取得し、(1)、(2)を、 Set d = Worksheets("sheet1").Range("A2:"A" & maxrow).以下省略 としましたが、エラーが出ました。 手直しして、(1)(2)を最終行をカウントしてA2から始まって、A11まで検索できるようにしたはずなのですが、やはりダメでした。Range("A2:"A" & maxrow)の部分と上記のプログラムの不具合を教えてください。よろしくお願いします。

  • エクセルVBAを勉強し始めたものです。多くの方にここで教えを請いながら

    エクセルVBAを勉強し始めたものです。多くの方にここで教えを請いながら日々少しづつ勉強しています。ありがとうございます。 (2) With Worksheets("sheet1").Range("A2:A" & Rows.Count) If (flag = False) Or (firstRange Is Nothing) Then Range("A2:A" & Rows.Count).Interior.ColorIndex = xlColorIndexNone (1) Set c = .Find(What:=myKey, After:=.Cells(.Count), LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByColumns) ギモン1 上記のプログラムですが、あるプログラムの一部分です。(1)のAfter:=.Cells(.Count), はどういう意味なのでしょうか。 afterは指定したセルの次から、という意味と書いてありました。 ギモン2 =.Cells(.Count),cellsと.countの.は(2)の With Worksheets("sheet1")と関連性があるのでしょうか。 ギモン3 .Cells(.Count),どうやって次のセルを指定しているのでしょうか。 よくわからないので、教えていただけますよう、よろしくお願いします。

  • エクセルVBAのFINDの質問です。

    エクセルVBAのFINDの質問です。 シート1    A    B    C     D 1 コード1 コード2 コード3 名 称 2  4    1     1 3  4    2     2 4  4    3     1 シート2    A    B 1 コード1 名 称 2  1   名称1 3  2   名称2 やりたいことは、シート1のD列に、シート1のコード3をもとにシート2から名称を取得したいのです。 下記に記したプログラムだと最初のFINDNEXTは動くのですが、 2回目でエラーになってしまい、次を読んでくれません。 どなたか、ご教授頂けますでしょうか。 シート1の検索条件はコード1の"4"です。 シート1のコード1は重複キーで、一レコードずつ読んで行き、各レコード毎にシート2を読みたい のです。 Dim シート1 As Worksheet Dim シート2 As Worksheet Dim obj As Object Dim Lin As Integer Dim mykey As Integer Dim obj1 As Object Dim Lin1 As Integer Dim mykey1 As Integer Dim st_Lin As Integer Set シート1 = ThisWorkbook.Worksheets("シート1") Lin = シート1.Cells(シート1.Rows.Count, 1).End(xlUp).Row mykey = "4" Set obj = シート1.Range("A1", "A" & Lin).Cells.Find(What:=mykey, _ LookIn:=xlValues, _ lookat:=xlWhole, _ SearchOrder:=xlByColumns) If obj Is Nothing Then   MsgBox ("異常です")   Exit Sub Else   st_Lin = obj.Row   Do Until obj.Row <> st_Lin    Set obj = シート1.Range("A1", "A" & Lin).FindNext(obj)    If obj Is Nothing Then     Exit Do    Else     Set シート2 = ThisWorkbook.Worksheets("シート2")       With シート2          Lin1 = .Cells(シート2.Rows.Count, 1).End(xlUp).Row          mykey1 = シート1.Cells(obj.Row, 3).Value          Set obj1 = .Range("A1", "A" & Lin1).Cells.Find          (What:=mykey1,LookIn:=xlValues,lookat:=xlWhole,SearchOrder:=xlByColumns)          If obj1 Is Nothing Then           MsgBox ("名称取得できませんでした")           Exit Sub          Else            シート1.Cells(obj.Row, 4).Value = .Cells(obj1.Row, 2).Value          End If       End With    End If   Loop End If

  • エクセルVBAを勉強中の者です。

    エクセルVBAを勉強中の者です。 今、あるソースを書いていて、それなりに上手くいったので、仮で、これまで、 dim e as string と宣言していたのを、eをdataaddress1に変更して、ソース中のeも全て、dataaddress1に変更しました。以下は途中のソースです。変更まではソースは正常に作動していました。 Range("B2:B" & Rows.count).Interior.ColorIndex = xlColorIndexNone '初めての検索処理 Set data1 = .Find(What:=myKey, After:=.Cells(.count), LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByColumns) '最初の検索で見つからなければ、 If data1 Is Nothing Then MsgBox "データは見つかりません", vbExclamation Exit Sub '最初の検索で見つかれば Else dataaddress1 = data1.Address TextBox1.Value = Range(dataaddress1).Value TextBox2.Value = Range(dataaddress1).Offset(0, 1).Value 分類.Value = Range(dataaddress1).Offset(0, 2).Value データ番号.Value = Range(dataaddress1).Offset(0, -1).Value dataaddress1に変更したとたんに、実行時エラー1004 Rangeメソッドは失敗しました'Globalオブジェルト"というメッセージがでました。 何か、stringでの変数の宣言の仕方に問題があるのでしょうか、ご存知の方教えて下さい、よろしくお願いします。

  • エクセルVBAの勉強初歩のものです。

    エクセルVBAの勉強初歩のものです。 今A列に社名、B列に住所、C列に業務内容と記載されています。データは今のところ十数行です。フォームのテキストボックスでキーワードを入れて、検索ボタンを押して、A列の社名で検索してヒットすれば、社名、そのセルの右隣(B列)、その又右隣(C列)のセルの内容をフォームのテキストボックスに表示しようというものです。以下はソースの一部です。 '検索範囲設定 With Worksheets("sheet1").Range("A2:A" & Rows.Count) If (flag = False) Or (firstRange Is Nothing) Then    '初めての検索処理 '初めての検索処理 Set c = .Find(What:=myKey, After:=.Cells(.Count), LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByColumns) '最初の検索で見つからなければ、 If c Is Nothing Then MsgBox "データは見つかりません", vbExclamation Exit Sub '最初の検索で見つかれば Else (1) d = c.Address (2) Set e = d (3) Debug.Print d.Value (1)でヒットしたセルのアドレスをD(stringで定義)してそのまま、offset(0,1).valueとしようとしたのですが、offsetはオブジェクトでないと使用できないとの事。 だったら、eをオブジェクトで定義(dim d as object)として実行したら、= dで型が一致しませんとエラーがでました。 やりたいことは、A列で検索したセルのアドレスの把握はできているので、その右隣、そのまた右隣のセルのアドレスを取得する方法です。 もう一つやりたいことはその把握したセルのアドレスに記載されている情報を取得する方法です。(3)でも型が一致しませんとエラーが出ました。てっきり、 textbox1 = d.valueなんて感じでできるのだと思っていましたが。 おそらく方向としては間違っていないのでしょうけど、どなたか間違いと改善方法をよろしくお願いたします。

  • vba

    下記はある文字列を検索して何か処理する のコードの一部ですが。 if TypeName(ret) <> "Boolean" Thenのところはどういう意味でどういうことをやろうとしているのか、わかりやすく説明してください。 "Boolean"て何 等しければどうする? 等しくなければどうする? ret = Application.InputBox("検索文字列を入力してください")   If TypeName(ret) <> "Boolean" Then     With mySht.Cells       Set r = .Find(ret, LookIn:=xlValues, lookat:=xlPart)

  • 簡単なVBA

    エクセルで特定の列データを削除したいのですが シンプルな形を教えてください ちなみに今は以下のようなVBAを使っています。 Sub 特定の列を削除する() For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 If Cells(1, i) = "りんご" Then Columns(i).Delete End If Next i For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 If Cells(1, i) = "みかん" Then Columns(i).Delete End If Next i For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 If Cells(1, i) = "ばなな" Then Columns(i).Delete End If Next i End Sub

  • 御願いします

    Sheet4にある表から同じ値を検索するマクロです。 同じ値があったセルの背景を黄色に,ただし空白セルは空白の ままにしたいのですが。 うまく動きません。 初めてマクロを立てました。 どうか解決にお力かして下さい。 ********************************************************* Private Sub Worksheet_Change(ByVal Target As Excel.Range) Dim RetRange As Range Dim lngYCnt As Long Dim intXCnt As Integer lngYCnt = Worksheets("Sheet4").UsedRange.Rows.Count intXCnt = Worksheets("Sheet4").UsedRange.Columns.Count For i = 1 To lngYCnt For j = 1 To intXCnt If Cells(i, j).Value = "" Then Cells(i, j).Interior.ColorIndex = xlNone Else Set RetRange = Selection.Find(What:=Cells(i, j).Value, _ after:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, _ SearchDirection:=xlNext) If Not RetRange Is Nothing Then If RetRange.Address <> Cells(i, j).Address Then RetRange.Interior.ColorIndex = 36 Cells(i, j).Interior.ColorIndex = 36 End If Next Next End If ErrorHandler: End Sub

  • Excel VBA; 複数のループ処理

    ↓のようなコードがあります。 Dim i As Long, MaxRow1 As Long, MaxRow2 As Long MaxRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row MaxRow2 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To MaxRow1 Worksheets("Sheet1").Cells(i, 1).Value = i . Next i For i = 1 To MaxRow2 Worksheets("Sheet2").Cells(i, 1).Value = i . Next i これらを最大行の多いシートに合わせて、パフォーマンスを良くしたいと思います。 同様の処理をシート1、シート2で実施しているので纏めて記述したいです。 シート1、シート2に対する処理をサブルーチンにする方法しかありませんか? どなたかお願いします。 If MaxRow1 >= MaxRow2 Then For i = 1 To MaxRow1 Else For i = 1 To MaxRow2 End If Worksheets("Sheet1").Cells(i, 1).Value = i Worksheets("Sheet2").Cells(i, 1).Value = i . Next i

  • VBA初心者です。A1からA11にデータがあります。画面のテキストボッ

    VBA初心者です。A1からA11にデータがあります。画面のテキストボックスに例えば、山と入力し、ボタンをクリックする度、その文字を含むセルに色をつけようとしています。山を含むデータが3個あれば3回ボタンをクリックしないと終了しないというわけです。 データに山の文字を含むセルが複数あった時、下のプログラムでは1回ボタンをクリックした時、色が付きます。2回目以降は(1)でエラーです。 山と言う文字がA3、A6、A9にあれば、1回目はA3を検索、2回目以降はA4から検索しA6で着色、3回目はA7から検索してA9で着色、最後の行までいけばデータは以上、というメッセージを表示ということです。 プログラムは検索部分だけ記載しています。 'データ領域、最終行取得 Worksheets("Sheet1").Activate Range(Cells(2, 1), Cells(maxRow, 1)).CurrentRegion.Select If flag = False Then Set c = Worksheets("Sheet1").Range(Cells(2, 1), Cells(maxRow, 1)).CurrentRegion.Find(What:=myKey, LookIn:=xlValues, lookat:=xlPart, SearchOrder:=xlByColumns) c.Interior.ColorIndex = 4 flag = True Else (1) Set d = Worksheets("Sheet1").Range(Cells(2, 1), Cells(maxRow, 1)).CurrentRegion.FindNext(c) d.Interior.ColorIndex = 4 End If flagは Option Explicit Dim flag As Boolean で宣言。flagは、 Private Sub UserForm_Click() flag = False End Sub でフォームロード時にfalseとします。 Flagはテキストボックスに入力した文字をクリアするボタンをクリックした時再びfalseに設定します。 Flagがfalseの時は1度目の検索。2度目以降はTrue。やりたいことは、 1,1度目の検索のセルのアドレスをどこかに保存し、2回目以降のボタンのクリック(Flagがtrue時)はそのセルの次のセルから検索を行う。 2,2回目以降ヒットしたセルの次のセルから検索する。 3,データの最後のセルまで検索した時、メッセージで、"検索終了"といった表示を出す。 (1)はわからないので不完全のプログラムのまま記載しています。特に、1回目の検索したセルのアドレスをどう取得し、Range(Cells(2, 1), Cells(maxRow, 1))に代入すればよいのかわかりません。 Flagをたてるというのはいいアイデアに思ったのですが・・・ (1)前後のプログラムででどうやれば、1回目の検索時(Flagがfalseの時)のセルのアドレスを取得し、2回目以降のボタンのクリック時まで保存し、(1)に代入していけばよいのかわかりません。 ここまではナントカできたのですが・・・お助けください、よろしくお願いします。