• 締切済み

初めての投稿です。

初めての投稿です。 皆さま宜しくお願いします。 Excel2007を使用しており、ユーザフォーム内にリストボックスを使用しています。 そのリストボックスはシートのセルを参照するようセットしています。 テキストボックス内に文字を入力し、コマンドボタンを押すと リストボックスの文字列から部分一致したものを選択されるようにしたいのです。 完全一致のコードであれば 調べてわかったのですが 部分一致を行いたく、大変困っております。 まだ初心者のため、いろいろネットをみてコピペしてVBA作成中です。 1週間程ネットで探したり、してますが見つかりません。 その為、こちらに投稿させて頂きました。 至急コードが知りたくて困っております。 宜しくお願いします。 完全一致のコードは以下です Private Sub CommandButton1_Click() Dim i As Long If TextBox1.Text = "" Then Exit Sub For i = 0 To ListBox1.ListCount - 1 ''(1) If ListBox1.List(i) = TextBox1.Text Then ''(2) ListBox1.ListIndex = i ''(3) MsgBox ListBox1.ListIndex & "番目に見つかりました" Exit Sub End If Next i MsgBox "見つかりませんでした" End Sub

みんなの回答

  • machua
  • ベストアンサー率71% (28/39)
回答No.1

脳内実行なんで、動作確認してません。 参考程度に。 ■概要 「リストボックスの文字列が、テキストボックスの文字列と一致しているか」となっている箇所を、「テキストボックスの文字列が、リストボックスの文字列を含んでいるか」に変更 ■変更前 If ListBox1.List(i) = TextBox1.Text Then ''(2) ■変更後 If InStr(TextBox1.Text, ListBox1.List(i)) -InStr関数 http://officetanaka.net/excel/vba/function/InStr.htm

関連するQ&A

  • テキストボックス空欄への追加入力

    リストボックス1であ行の氏名項目を選択実行しテキストボックス1~8に入力された後にか行にリストボックス項目を変え氏名を選択実行した場合、下記のコードではテキストボックス1からまた上書きされる。テキストボックス空欄に続けて選択項目が入力される方法はあるのでしょうか。悩んでいます。どなたかコードがわかる方よろしくお願いします。 Private Sub 実行Cnd_Click() Dim cnt As Integer   Dim i As Integer If ListBox1.ListIndex = -1 Then Exit Sub cnt = 1 For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) Then Me.Controls("TextBox" & cnt).Text = ListBox1.List(i) cnt = cnt + 1 End If Next End Sub

  • リストボックスからの入力をテキストに貼付

    下記コードではリストボックあ行選択しテキスト1~6に入力後、クリアボタンで消去したあと、か行選択しテキストに入力したら7~貼付けになるクリアボタンで消去後、改めてテキスト1~入力するコードがありますか。どなたか解る方よろしくお願いします。 Private Sub 実行_Click() Static cnt As Integer Dim i As Integer If Listbox.ListIndex = -1 Then Exit Sub For i = 0 To Listbox.ListCount - 1 If Listbox.Selected(i) Then cnt = cnt + 1 If cnt > 10 Then cnt = 1 Me.Controls("TextBox" & cnt).Text = Listbox.List(i) End If Next End Sub Private Sub クリア_Click() Dim tbCont As Control With Me.MultiPage1 For Each tbCont In .Pages(.Value).Controls If TypeName(tbCont) = "TextBox" Then tbCont.Value = Null End If Next tbCont End With End Sub

  • エクセルマクロ_上書き(リストボックスでデータを抽出し、その行へ上書き)

    エクセルマクロ初心者です。(2003使用_ユーザーフォーム,リストボックス,テキストボックス,チャックボックス) Sheet1のデータをユーザーフォームへ反映させ、修正したものをその行へ上書きするマクロを作成したいと思っていますが、うまくいかないのでどなたかお教え願います。 (Sheet1―A8より表がはじまります) 管理番号 品名 数量 希望納期 変更数量 完納 コメント アカ12 みかん     40   8月3日 アオ35 りんご     30   8月5日 クロ54 なし     50   7月7日 アカ98 もも     20   9月1日 アオ43 すいか     35   8月3日 ●完納の行がチャックボックスで、チェックがついたら、”完納”と記載、チェックがついていなかったら空欄のまま。もし表に”完納”と記載されていたら、コマンドボタン1でデータを抽出した時に、チェックがつくようにしたいのです。が、まったくうまくいかないのです。 ●また、コマンド1での抽出データに値を入力したものを上書きすることは一部できるのですが、空欄にしたときに、空欄の状態(無記入)に上書きすることができません。 Private Sub UserForm_Initialize() Dim r As Range Set r = Sheets("Sheet1").Range("A8").CurrentRegion.Offset(1) Set r = r.Resize(r.Rows.Count - 1) With ListBox1 .ColumnWidths = "50;50;0;0;0;0;0" .ColumnCount = 7 .RowSource = r.Address(A8, G) End With End Sub Private Sub CommandButton1_Click() If ListBox1.ListIndex <> -1 Then TextBox1.Value = ListBox1.List(ListBox1.ListIndex, 0) TextBox2.Value = ListBox1.List(ListBox1.ListIndex, 1) TextBox3.Value = ListBox1.List(ListBox1.ListIndex, 2) TextBox5.Value = ListBox1.List(ListBox1.ListIndex, 4) TextBox6.Value = ListBox1.List(ListBox1.ListIndex, 6) End If If Not IsEmpty(ListBox1.List(ListBox1.ListIndex, 3)) Then TextBox4.Value = Format(CDate(ListBox1.List(ListBox1.ListIndex, 3)), "m/d") Else TextBox4.Value = "" End If End Sub Private Sub CommandButton2_Click() If ListBox1.ListIndex <> -1 Then Dim r As Range ' 元データの範囲を取得 Set r = Sheets("Sheet1").Range("A8").CurrentRegion.Offset(1) Set r = r.Resize(r.Rows.Count - 1) ' 日付型かどうかをチェック If IsDate(TextBox4.Value) Then ' 選択されたセルの更新 r(ListBox1.ListIndex + 1, 4) = TextBox4.Value End If r(ListBox1.ListIndex + 1, 7) = TextBox6.Value End If End Sub Private Sub CheckBox1_Click() If ListBox1.ListIndex <> -1 Then Dim l As Range Set l = Sheets("Sheet1").Range("A8").CurrentRegion.Offset(1) Set l = l.Resize(l.Rows.Count - 1) If CheckBox1.Value = True Then l(ListBox1.ListIndex + 1, 5).Value = "完納" If CheckBox1.Value = False Then l(ListBox1.ListIndex + 1, 5).Value = "<>" End If End If End If End Sub すみませんが、ご親切に教えていただけましたら幸いです。 よろしくお願いいたします。

  • リストボックスで選択した一行を一度にセルに入力したい

    Xcel2003でマクロ作成中です。以下のコードで、リストボックスで一行を選択しました。この選択した一行のデータのうち2個のデータをC列とD列に入力することができました。が、E列にもデータを入力したいのです。が色いろやってみましたができません。 Private Sub ListBox2_Click() With ListBox2 If .ListIndex = -1 Then MsgBox "項目を選択してくだい" Else ActiveCell.Value = ListBox2.list(ListBox2.ListIndex, 0) ActiveCell.Offset(0, 1).Value = ListBox2.list(ListBox2.ListIndex, 1) End If End With Unload UserForm3 End Sub 上のコードにどう追加記入したらよろしいでしょうか?

  • ユーザーフォームでの登録&編集

     ユーザーフォームのリストボックス(RowSource,P6:A26)で選択し14個のテキストボックスで編集しコマンドボタンでSheet(P6:AC26)にコピペしていますが、下記のコードだと無制限に登録されてしまいます。Sheetの範囲内で登録&編集のコードの書き方がありましたらご教示賜りたく存じます。(番号は自動入力でなくてもいいです。) Windows7・SP1 Office2010 Private Sub CommandButton2_Click() Dim varRag As Variant Dim myArray As Integer Dim i As Long varRag = Array(txtID, txtTextBox2, txtTextBox3, txtTextBox4, txtTextBox5, txtTextBox6, txtTextBox7, txtTextBox8, txtTextBox9, txtTextBox10, txtTextBox11, txtTextBox12, txtTextBox13, txtTextBox14) If TextBox3.Text = "" Then MsgBox "登録すべき内容がありません!", vbExclamation, "確認" Exit Sub End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual If ListBox1.ListIndex = -1 Then 'リストが選択していなかったら、 Cells(Rows.Count, 16).End(xlUp).Offset(1).Select For myArray = 0 To 9 With Selection txtID = .Row - 5 .Offset(, myArray) = varRag(myArray) End With Next myArray Else i = ListBox1.ListIndex + 6 Range("P" & i).Value = i - 5 Range("Q" & i).Value = TextBox2.Text Range("R" & i).Value = TextBox3.Text Range("S" & i).Value = TextBox4.Text Range("T" & i).Value = TextBox5.Text Range("U" & i).Value = TextBox6.Text Range("V" & i).Value = TextBox7.Text Range("W" & i).Value = TextBox8.Text Range("X" & i).Value = TextBox9.Text Range("Y" & i).Value = TextBox10.Text Range("Z" & i).Value = TextBox11.Text Range("AA" & i).Value = TextBox12.Text Range("AB" & i).Value = TextBox13.Text Range("AC" & i).Value = TextBox14.Text End If 'データをクリア ListBox1.ListIndex = -1 ID.Text = "" TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" TextBox5.Text = "" TextBox6.Text = "" TextBox7.Text = "" TextBox8.Text = "" TextBox9.Text = "" TextBox10.Text = "" TextBox11.Text = "" TextBox12.Text = "" TextBox13.Text = "" TextBox14.Text = "" Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub Private Sub ListBox1_Change() Dim targetRow As Integer With ListBox1 targetRow = .ListIndex ID.Text = .List(targetRow, 0) TextBox2.Text = .List(targetRow, 1) TextBox3.Text = .List(targetRow, 2) TextBox4.Text = .List(targetRow, 3) TextBox5.Text = .List(targetRow, 4) TextBox6.Text = .List(targetRow, 5) TextBox7.Text = .List(targetRow, 6) TextBox8.Text = .List(targetRow, 7) TextBox9.Text = .List(targetRow, 8) TextBox10.Text = .List(targetRow, 9) TextBox11.Text = .List(targetRow, 10) TextBox12.Text = .List(targetRow, 11) TextBox13.Text = .List(targetRow, 12) TextBox14.Text = .List(targetRow, 13) End With End Sub

  • Listindexの値が上手く取得できません。

    VBA初心者です。的外れな質問をしている場合にはご容赦ください。 まず ユーザーフォームを表示した時に、 Private Sub UserForm_Initialize() Set ws1 = Worksheets("s1") Set gui2 = 銘柄コードから検索 gui2.ListBox1.AddItem "銘柄コードで検索" gui2.ListBox1.AddItem "銘柄名で検索" gui2.ListBox1.AddItem "銘柄カナで検索" End Sub とリストボックスの各項目を作成しました。 Listboxをクリックした時にlistindexを「リストの数」に格納 する(自分のイメージ) Private Sub ListBox1_Click() Set gui2 = 銘柄コードから検索 Set ws1 = Worksheets("s1") Dim リストの数 As Integer リストの数 = gui2.ListBox1.ListIndex End Sub (自分のイメージ)コマンドボタン2をクリックすると 現在選択されているListbox1のListindexが「リストの数」 に格納されているので、次のSelect文の動きをすると思っています。 Private Sub CommandButton2_Click() Set gui2 = 銘柄コードから検索 Dim リストの数 As Integer リストの数 = gui2.ListBox1.ListIndex Select Case リストの数 Case 0 MsgBox リストの数 Call 銘柄コードで検索 TextBox1.Text = "" gui2.TextBox1.SetFocus Case 1 MsgBox リストの数 Call 銘柄名で検索 MsgBox リストの数 TextBox1.Text = "" gui2.TextBox1.SetFocus Case 2 MsgBox リストの数  Call 銘柄カナで検索 TextBox1.Text = "" gui2.TextBox1.SetFocus End Select End Sub コマンドボタン2をクリックした場合に、ListIndexの値を判断し、Select文 の条件どおりに動作させるためには、どのようにしたらよいでしょうか? EXCEL2000 を使っています。

  • 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

  • リストボックスから複数行を選択し、その複数のデータをセルに入力したい

    Excel2003でマクロをつくっています。シートのB列を右クリックすると、リストボックスが表示され 任意1行を選択するとシートのB列、C列、D列のセルにデーターが入力されます。 Private Sub ListBox2_Click() With ListBox2 If .ListIndex = -1 Then MsgBox "項目を選択してくだい" Else ’シートが保護されていたら保護を解除 If ActiveSheet.ProtectContents = True Then ActiveSheet.Unprotect End If ActiveCell.Value = ListBox2.List(ListBox2.ListIndex, 0) ActiveCell.Offset(0, 1).Value = ListBox2.List(ListBox2.ListIndex, 1) ActiveCell.Offset(0, 2).Value = ListBox2.List(ListBox2.ListIndex, 2) ActiveSheet.Protect End If End With Unload UserForm3 End Sub このリストボックスから複数の行を選択し、シートのB列、C列、D列のセルにデーターを入力したいのですが、Multiselectプロパティを変更しても、一行のみしか入力できません。 上のコードをどうかえたらよろしいでしょうか。

  • リストボックスから項目を選択してセルに入力したいのです

    EXcel2003でマクロ作成中です。エクセルシートのN列を右クリックすると、ユーザーォームが現れ、その中のリストボックスから項目を選択すると選択文字が白色に反転します。 ユーザーホームの下方に設置した「入力する」ボタンをクリックする、アクティブセルにテキスト文字列が挿入されます。 Option Explicit Private Sub CommandButton1_Click() With ListBox1 If .ListIndex = -1 Then MsgBox "項目を選択してくだい" Else ActiveCell.Value = ListBox1.list(ListBox1.ListIndex) End If End With Unload UserForm1 End Sub --------------------------- Private Sub CommandButton2_Click() Unload UserForm1 End Sub ------------------------------ これと同じものをB列につくりました。エクセルシートのB列を右クリックすると、リストボックスが表示されますが、その中の項目を選択しようとすると、一瞬にしてユーザーフォーム自体が消えてしまい項目を 選択できません。 Private Sub CommandButton1_Click() With ListBox2 If .ListIndex = -1 Then MsgBox "項目を選択してくだい" Else ActiveCell.Value = ListBox2.list(ListBox2.ListIndex) End If End With Unload UserForm2 End Sub ----------------------------- Private Sub CommandButton2_Click() Unload UserForm2 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