• 締切済み

Excelでセルの検索結果をテキストボックスに表示

先日、この内容の回答が来たのですが、いろいろテストしていたら、検索ボックスに入力して1回目は検索できるのですが、続けて次の検索をしようテキストボックスに入力してボタンを押しても以前の内容で検索されてしまいます。 どこを修正すれば良いのか教えてください。 UserForm1に、検索条件を入れるTextBox4、 該当した行のB,C,D列表示用の、TextBox1、TextBox2,TextBox3の3つ(計4つ)を設けます。 コマンドボタンを1つ(Captionは「検索・次検索」)設けます。検索・次検索ボタンです。 標準モジュールに Public ac As Range Public startaddr As String 変数の次ステップ(イベント)への受け渡し用です。 UserForm1のコマンドボタンのクリック・イベント・プロに Private Sub CommandButton1_Click() Dim r As Range If ac Is Nothing Then d = Range("A65536").End(xlUp).Row With ActiveSheet.Range(Cells(1, "A"), Cells(d, "A")) Set r = .Find(what:=TextBox4) rr = r.Row TextBox1.Text = Cells(rr, "B") TextBox2.Text = Cells(rr, "C") TextBox3.Text = Cells(rr, "D") Set ac = r r.Activate MsgBox ac.Address startaddr = ac.Address Exit Sub End With Else MsgBox ac.Address d = Range("A65536").End(xlUp).Row MsgBox d With ActiveSheet.Range(Cells(1, "A"), Cells(d, "A")) Set r = .FindNext(ac) rr = r.Row TextBox1.Text = Cells(rr, "B") TextBox2.Text = Cells(rr, "C") TextBox3.Text = Cells(rr, "D") Set ac = r r.Activate If r.Address = startaddr Then TextBox1.Text = "終わり" Exit Sub End With End If End Sub

みんなの回答

  • papayuka
  • ベストアンサー率45% (1388/3066)
回答No.1

これを入れるとか、、、 Private Sub TextBox4_AfterUpdate()   Set ac = Nothing   StartAddr = "" End Sub あと気になるところは、見つからない事を想定していない所とFind の LookAt (完全一致 or 部分一致)を指定していない所です。 私なりに修正してみました。 TextBox4_AfterUpdate はこちらでも必要です。 Private Sub CommandButton1_Click() Dim r  If ac Is Nothing Then    Set r = ActiveSheet.Columns(1).Find(what:=TextBox4.Text, LookAt:=xlWhole)  Else    Set r = ActiveSheet.Columns(1).FindNext(ac)  End If  If Not r Is Nothing Then    For i = 1 To 3      Me.Controls("TextBox" & i).Text = r.Offset(0, i)    Next i    r.Activate: Set ac = r    If r.Address = StartAddr Then      MsgBox "最初のセルです", vbOKOnly + vbInformation, "検索終了"    End If    If StartAddr = "" Then StartAddr = r.Address  End If End Sub

j3j355
質問者

補足

有難うございました。 完璧です。 実はもうひとつ書くのを忘れてしまったのですが、セルの色もテキストボックスに表示できないかなと思っていますが、如何でしょうか? 行によって色が付いているので、その色も表示できないでしょうか? こんなことって出来るのでしょうか? 教えてください。

関連するQ&A

  • Excelでセル検索したセルの色をテキストボックスに表示

    セル検索した結果をテキストボックスに表示する時、文字は表示できましたが、セルの色もテキストボックスに表示したいのですが、何処を修正したらいいのか分かりません。 教えてください。 宜しくお願いします。 Sub AAA() strMoji$ = UserForm1.TextBox1.Text If UserForm1.TextBox1.Text = "" Then MsgBox "検索条件を入力してください。", 48 Exit Sub End If On Error GoTo Fail Worksheets("Sheet1").Range("a:a").Find(What:=strMoji, After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ ).Activate lonNUM& = Selection.Row UserForm1.TextBox2.Text = Cells(lonNUM, 2).Value UserForm1.TextBox3.Text = Cells(lonNUM, 3).Value UserForm1.TextBox4.Text = Cells(lonNUM, 4).Value UserForm1.TextBox5.Text = Cells(lonNUM, 5).Value UserForm1.TextBox6.Text = Cells(lonNUM, 6).Value UserForm1.TextBox7.Text = Cells(lonNUM, 7).Value UserForm1.TextBox8.Text = Cells(lonNUM, 8).Value Exit Sub Fail: MsgBox "該当なし", 48 End Sub

  • Excelで検索結果表示の修正

    下記のマクロでA列だけ検索できるようにしたいのですが、どこを修正したらいいのか教えてください。 Private Sub CommandButton1_Click() AAA End Sub Sub AAA() strMoji$ = UserForm1.TextBox1.Text If UserForm1.TextBox1.Text = "" Then MsgBox "検索条件を入力してください。", 48 Exit Sub End If On Error GoTo Fail Cells.Find(What:=strMoji, After:=ActiveCell, LookIn:=xlValues, LookAt:= _ xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ ).Activate lonNUM& = Selection.Row UserForm1.TextBox2.Text = Cells(lonNUM, 2).Value UserForm1.TextBox3.Text = Cells(lonNUM, 3).Value Exit Sub Fail: MsgBox "該当なし", 48 End Sub Private Sub UserForm_Click() 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

  • リストボックスの内容を検索したいが...

    エクセル2019を使っています。 添付画像のようにユーザーフォームにテキストボックスとリストボックスを作り、テキストボックスに入力した文字でリストボックスの内容を検索しようとコードを作成しました。 Private Sub TextBox1_Change() Dim LastRow As Integer Dim rng As Range, r As Range With Worksheets("Sheet1") If .AutoFilterMode <> True Then .Range("A1").AutoFilter End If LastRow = .Cells(Rows.Count, 1).End(xlUp).Row .Range("A1").AutoFilter 1, "*" & TextBox1.Value & "*" If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then Set rng = .Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible) Else Me.ListBox1.Clear Exit Sub End If End With Me.ListBox1.Clear With Me.ListBox1 For Each r In rng .AddItem r.Value .List(.ListCount - 1, 1) = r.Offset(0, 1).Value Next r End With End Sub Private Sub UserForm_Initialize() Dim LastRow As Integer Dim rng As Range, r As Range With Worksheets("Sheet1") If .AutoFilterMode <> True Then .Range("A1").AutoFilter End If LastRow = .Cells(Rows.Count, 1).End(xlUp).Row Set rng = .Range("A2:A" & LastRow) End With With Me.ListBox1 .ColumnCount = 1 For Each r In rng .AddItem r.Value .List(.ListCount - 1, 1) = r.Offset(0, 1).Value Next r End With ListBox1.ListIndex = 0 End Sub とりあえず検索はできるのですが、使用されていない文字や記号を入力したあとにバックスペースキーで入力した文字や記号を削除するとリストボックスの内容が意図した内容で表示されません。 どこを修正したらいいでしょうか。

  • コンボボックスとテキストボックスをセルへ

    コンボボックスのデータを行へ表示されるよう下記の通りやりました。 続けてテキストボックスを指定した同じ行のセルへ入力されるように したいのですが、いろいろ調べたのですが、解決できず ここで助言いただけたらと思います。 また textbox1はA列 textbox2はB列 textbox3はM列 へとコンボボックスのデータを挟む形での入力となります。 ちなみにテキストボックスのプロジェクト名は変更してあります。 Private Sub CommandButton1_Click() Dim lrow As Long, i As Long With Worksheets("製品化") lrow = .Range("F" & Rows.Count).End(xlUp).Row For i = 0 To 6    .Cells(lrow + 1, i + 6).Value = itemname.List(listno, i) Next i End With End Sub

  • Excel VBA でテキストボックスの値をセルA列から検索

    いつもお世話になります。 Private Sub CommandButton3_Click() Dim 行 As String Dim 列 As String Dim 最終行 As String Dim 検索行 As String Dim メッセージ As Integer Dim 一致 As Range Dim myNO As Variant Dim i As Long Sheets(3).Select 最終行 = Range("A2").End(xlDown).Offset(1).Select 行 = ActiveCell.Row 列 = ActiveCell.Column myNO = TextBox2.Value 検索行 = Range("A2").End(xlDown).Select ※・・・Set 一致 = Range("A2:検索検").Findwhat:=TextBox2,lookat:=xlWhole) If 一致 Is Nothing Then MsgBox "データがありません。新規コード入力します。" Cells(行, 列 + 0) = UserForm1.TextBox2.Value Cells(行, 列 + 1) = UserForm1.ComboBox7.Value Else i = Cells(行 - 1, "A") Cells(i, 列 + 0) = UserForm1.TextBox2.Value Cells(i, 列 + 1) = UserForm1.ComboBox7.Value End If End Sub 「エラー1004'Range'メソッドは失敗しました'Global'オブジェクト」とでます。※印が黄色になっています。 ユーザーフォーム1のテキストボックスの値をシート3のA列から検索して、一致すれば、A列の一致セルに上書き入力して、一致が無い場合はA列の空白セルに追加入力したいのです。よろしくお願い致します。

  • Excel オーダーフォームのテキストボックス入力について

    オーダーフォームを作成し、テキストボックスを2つ以上作成し、コマンドボタンを1つ作りました。 同じ行ですべてを入力できるようにしたいのですが、どうしたらよいでしょうか? テキストボックス1の値を入力するためのコマンドは、最下位の行を探してそこに入力するようなコマンドを作っているはずです…その横の列にテキストボックス2の値を入力し、その横の列にテキストボックス3の値を入力し…というようにしていきたいのです。 Private Sub CommandButton1_Click() Dim lRow As Long With Worksheets("sheet1") lRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & lRow + 1).Value = TextBox1.Value End With TextBox1.Value = "" TextBox1.SetFocus End Sub

  • excelのテキストボックスで、うまく動作しない

    a列に行間隔不等で1~100の数字を記入してあります。 このセル番地を検索する為、テキストボックスで、以下の記述を試しましたが、うまくいきません。 1、lostfocusに設定すると、 テキストボックス入力後、エンターキーを押してもフォーカスが移動しない。 2、changeに設定すると、 2桁数字を入力できない。(1数字だけでフォーカスが移動してしまう) 設定の不備な点、 あるいは、規定の検索メニュウ使用以外で、 最適の方法を教えてください。 Private Sub TextBox1_Change() Dim dx dx = Application.WorksheetFunction.Asc(TextBox1.Value) With ActiveSheet.Range("a:a") Set c = .Find(dx, LookIn:=xlValues) If Not c Is Nothing Then c.Activate Else MsgBox "該当なし" End If End With TextBox1.Value = "" End Sub

  • エクセルマクロ_テキストボックスをシートに反映(その2)

    エクセルマクロ初心者です。(2003使用_ユーザーフォーム) 先ほどは大変お世話になりました。 複数行に応用させようとしたのですが、管理番号が余計に記載(テキストボックス(出荷日など)が空欄であっても、管理番号だけはとられてしまいます)されてしまいます。すみませんが、ご教授よろしくお願いいたします。 リストボックス1のデータは、Sheet1を表示しています。→管理番号はSheet2のA最終行に記載されます。 テキストボックス1(回答日)は、上記の管理番号記載のとなりに、 テキストボックス2(出荷日)は、テキストボックス1記載のとなりに、 ・・・とテキストボックス4(コメント)(これはK列)に1行で記載されます。 ↑ここまでは、教えていただいたので、完璧なのですが、 テキストボックス2~4までの内容を、あと複数行(4件)追加できるように試してみたのですが、空欄であっても管理番号だけは常に記載されてしまいます。 テキストボックス2と5に記載されている場合は、Sheet2に値を反映させるが、空欄の場合は、値を反映させないようにしたいのです。 (Sheet1=データベース) C5   D5 管理番号 品名 アカ12 りんご アオ56 みかん クロ34 なし クロ89 すいか アオ12 もも (Sheet2=入力シート) A(管理番号)    B(回答日)    C(出荷日)   D(数量)     K(コメント) アオ56        8月9日        8月10日      75     送り先の確認 アオ56                    8月11日      80 クロ34        9月4日        9月5日      80 (今回は、2行で作成した場合のマクロを記載しました) Private Sub UserForm_Initialize() With ListBox1 .ColumnWidths = "0;0;50;50" .ColumnCount = 4 .RowSource = "Sheet1!A5:D" & Worksheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row End With End Sub Private Sub CommandButton1_Click() If TextBox2.Value Then Dim lRow As Long With Worksheets("Sheet2") lRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & lRow + 1).Value = ListBox1.List(ListBox1.ListIndex, 2) If IsDate(TextBox1.Value) Then .Range("B" & lRow + 1).Value = TextBox1.Value End If If IsDate(TextBox2.Value) Then .Range("C" & lRow + 1).Value = TextBox2.Value End If If IsNumeric(TextBox3.Value) Then .Range("D" & lRow + 1).Value = TextBox3.Value End If .Range("K" & lRow + 1).Value = TextBox4.Value End With End If If TextBox5.Value Then Dim llRow As Long With Worksheets("Sheet2") llRow = .Range("A" & Rows.Count).End(xlUp).Row .Range("A" & llRow + 1).Value = ListBox1.List(ListBox1.ListIndex, 2) If IsDate(TextBox5.Value) Then .Range("C" & llRow + 1).Value = TextBox5.Value End If If IsNumeric(TextBox6.Value) Then .Range("D" & llRow + 1).Value = TextBox6.Value End If .Range("K" & llRow + 1).Value = TextBox7.Value End With End If Dim myCtrl As Control For Each myCtrl In Controls If TypeName(myCtrl) = "TextBox" Then myCtrl.Value = vbNullString End If Next End Sub (ユーザーフォーム) リストボックス1=Sheet1のデータを反映 テキストボックス1(回答日) テキストボックス2(出荷日),テキストボックス3(数量),テキストボックス4(コメント)←1件目 テキストボックス5(出荷日),テキストボックス6(数量),テキストボックス7(コメント)←2件目 ↑1件目のみでコマンドボタンを押した場合は、1件目のみの管理番号取得をしたいのです。が今は、2件目が空欄でも管理番号はとられてしまいます。 長くなってしまいすみません。 どなたかご回答いただければ幸いです。よろしくお願いいたします。

  • エクセル ユーザーフォームテキストボックスについて

    テキストボックスからセルへの入力について教えていただきたいのですが、 ネットからサンプルを落として勉強しております。 以下のコードを下の画像のように見出しを3から7まで項目を増やしたい場合、 どの部分を書き換えたらいいのでしょうか? よろしくお願いいたします。 Private Sub CommandButton1_Click() Dim LASROW As Long Dim f As Long With Worksheets("Sheet1") 'A列の最終行を取得 LASROW = .Range("A" & CStr(Rows.Count)).End(xlUp).Row 'セルに書き込み For f = 0 To 2 .Range("A" & CStr(LASROW)).Offset(1, f).Value = Me.Controls("TextBox" & f + 1).Value Next End With 'TextBox1,2,3をクリア For f = 1 To 3 Me.Controls("TextBox" & f).Value = "" Next 'TextBox1にフォーカスを移動 Me.TextBox1.SetFocus End Sub