[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ユーザーフォーム検索』（ゆり）
ユーザーフォームを使用した検索画面の作成について質問させて頂きます。
【Sheet1：シート名（”コード表”）】
頭文字 コード 口座名(漢字) 口座名(ｶﾅ) 金融機関ｺｰﾄﾞ 金融機関名(ｶﾅ) ・・・（15列）
え K-11 A社 ｴｰｼｬ 1 ﾐｽﾞﾎ ・・・・
ひ K-12 B社 ﾋﾞｰｼｬ 5 ﾐﾂﾋﾞｼﾄｳｷｮｳUFJ・・・・
： ： ： ： ： ：
【Sheet2：シート名（"集計表"）】
コード 口座名(漢字) 口座名(ｶﾅ) 金融機関コード 金融機関名(ｶﾅ) ・・・・
Sheet("集計表")のA列（コードの列）のセルをダブルクリックすると、ユーザフォームが表示されます。
ﾕｰｻﾞｰﾌｫｰﾑ：ｵﾌﾞｼﾞｪｸﾄ名（"frm_torihikisaki"）
ﾃｷｽﾄﾎﾞｯｸｽ：ｵﾌﾞｼﾞｪｸﾄ名("textkensaku") ・・・ 検索用文字入力
ﾘｽﾄﾎﾞｯｸｽ：ｵﾌﾞｼﾞｪｸﾄ名("listtorihikisaki")・・・ sheet(“コード表”)のコード・口座名(漢字)・口座名(ｶﾅ)を表示
ﾃｷｽﾄﾎﾞｯｸｽ：ｵﾌﾞｼﾞｪｸﾄ名("textginkou")
ﾃｷｽﾄﾎﾞｯｸｽ：ｵﾌﾞｼﾞｪｸﾄ名("textsiten")
ﾃｷｽﾄﾎﾞｯｸｽ：ｵﾌﾞｼﾞｪｸﾄ名("textkamoku")
ﾃｷｽﾄﾎﾞｯｸｽ：ｵﾌﾞｼﾞｪｸﾄ名("textbangou")
ﾃｷｽﾄﾎﾞｯｸｽ：ｵﾌﾞｼﾞｪｸﾄ名("textcharge")
✧ やりたいこと
1."textkensaku" に文字(ｶﾅ)を入力し、"listtorihikisaki" を絞り込みたい。
D列：口座名(ｶﾅ)での絞り込み検索
2."listtorihikisaki" で表示された口座名を選択した際、選択した口座名に対応した情報を他のﾃｷｽﾄﾎﾞｯｸｽに表示させたい。
"textginkou" には、G列の金融機関名(漢字)を表示
"textsiten" には、J列の支店名(漢字)を表示
"textkamoku" には、L列の科目を表示
"textbangou" には、M列の口座番号を表示
"textcharge" には、N列の手数料負担区分を表示
3."listtorihikisaki" で表示された口座名をダブルクリックすると、Sheet(“集計表”)のアクティブセルに、コードが転記される
'*****************************************************
'検索フォームを開いた時の処理
'*****************************************************
Private Sub UserForm_Initialize()
Dim wLastGyou As Long
'最終行番号を取得
wLastGyou = Worksheets("コード表").UsedRange.Rows.Count
'リストボックスに「コード表」のリストをセット
With listtorihikisaki
'列の指定：3列とする
.ColumnCount = 3
'見出しの設定：無し
.ColumnHeads = False
'リストボックスの値にセルC2からD最終行までセット
.RowSource = "コード表!B2:D" & wLastGyou
End With
End Sub
説明が分かりにくいようであれば、補足説明いたします。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
検索範囲：sheet("コード表")のD列【口座名(ｶﾅ)】
ﾘｽﾄﾎﾞｯｸｽに表示されてしまう値：sheet("コード表")のG列【金融機関名(漢字)】
ﾘｽﾄﾎﾞｯｸｽには、コード・口座名(漢字)・口座名(ｶﾅ)を表示したい。
以下のコードをどのように変更すれば良いでしょうか。
Private Sub Textkensaku_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim Obj As Object
Dim wAddST As Variant
Dim wAddress As Variant
Dim wtorihikisaki As Variant
'検索範囲を設定
With Worksheets("コード表").Columns(4)
'テキストボックスの値が含まれるセルを検索
Set Obj = .Cells.Find( _
What:=Textkensaku.Value, _
LookIn:=xlValues, _
lookat:=xlPart, _
MatchByte:=False)
'検索対象がない場合はメッセージを表示
If Obj Is Nothing Then
MsgBox "対象科目は存在しません。", _
vbOKOnly + vbInformation, "検索"
Else
'リストボックスをクリア
listtorihikisaki.RowSource = ""
'検索にヒットした先頭のセルのアドレスをセット
wAddST = Obj.Address
'検索の繰り返し処理
Do
'検索にヒットしたセルのアドレスをセット
wAddress = Obj.Address
'検索にヒットしたセルの値を取得
wtorihikisaki = .Range(wAddress).Value
'リストボックスに追加
listtorihikisaki.AddItem wtorihikisaki
'次の検索を行う
Set Obj = .Cells.FindNext(Obj)
'最初にヒットしたアドレスと同じ場合は処理を終了
If Obj.Address = wAddST Then Exit Do
Loop
End If
End With
End Sub
（ゆり） 2014/08/17(日) 11:04
試していない机上コードなので、動かなかったらゴメンナサイ。
Else
'リストボックスをクリア
listtorihikisaki.Clear
'検索にヒットした先頭のセルのアドレスをセット
wAddST = Obj.Address
'検索の繰り返し処理
Do
'リストボックスに追加
listtorihikisaki.AddItem Obj.Value
'次の検索を行う
Set Obj = .Cells.FindNext(Obj)
'最初にヒットしたアドレスと同じ場合は処理を終了
If Obj.Address = wAddST Then Exit Do
Loop
listtorihikisaki.ListIndex = 0
End If
とこんな形ではないでしょうか。 http://officetanaka.net/excel/vba/tips/tips26.htm （Mook） 2014/08/17(日) 13:09
検索が D 列なので、表示したいのが別の列(例えば G列)なら Obj.Offset(0,3).Value のように、検索したセルからどれだけ横（右）なのかを指定してください。
複数データをどのように出したいかわかりませんが一例まで。
listtorihikisaki.AddItem Obj.Offset(0,-2).Value _
& " " & Obj.Offset(0,-1).Value _
& " (" & Obj.Offset.Value & ")"
追伸：
コードをパッと見、
>ﾘｽﾄﾎﾞｯｸｽに表示されてしまう値：sheet("コード表")のG列【金融機関名(漢字)】
という現象になるようには見えないのですが、提示のコードは実際のコードでしょうか。
（Mook） 2014/08/17(日) 13:20
ﾘｽﾄﾎﾞｯｸｽにコード・口座名(漢字)・口座名(ｶﾅ)を表示することができました。
✧ コードは、実際のコードをそのまま貼付させて頂きました。
✧ ﾘｽﾄﾎﾞｯｸｽのクリアについて
〉'リストボックスをクリア
〉 listtorihikisaki.Clear
で、なぜかエラーが発生してしまったので、
listtorihikisaki.RowSource = "" を継続使用しました。なぜでしょう？？
✧ ﾘｽﾄﾎﾞｯｸｽの幅について
'幅の指定
.ColumnWidths = "50;200;300"
に設定しているのですが、ﾘｽﾄﾎﾞｯｸｽで抽出された検索結果では、幅の指定通りになりません。
どこかで再度、幅の設定をかけるのでしょうか。
✧ 検索文字の設定について
検索用ﾃｷｽﾄﾎﾞｯｸｽ：Textkensakuでの文字入力を、半角カナのみに設定したいのですが、どのように設定すれば
良いでしょうか。
（ゆり） 2014/08/17(日) 18:37
.ColumnWidths = "50;200;300"
＞複数データをどのように出したいかわかりませんが一例まで。
＞ listtorihikisaki.AddItem Obj.Offset(0,-2).Value _
＞ & " " & Obj.Offset(0,-1).Value _
＞ & " (" & Obj.Offset.Value & ")"
アドバイス通りにコードを入力したところ、複数データが1列として捉えられてしまう為、
表示が途中で切れてしまいます。
できればﾘｽﾄﾎﾞｯｸｽの3列の幅は変えたくない為、
複数データを1列ごとに表示させる方法がありましたら、ご助言頂ければと思います。
どうぞよろしくお願い致します。
例）検索結果
K-12 B社 ﾋﾞｰｼｬ
（ゆり） 2014/08/18(月) 22:34
＞複数データを1列ごとに表示させる方法 は「AddItem」の所で 今は一列になる所を、複数列にしたいので ↓の様に探してみるとどうですか？ https://www.google.co.jp/#q=additem+%E8%A4%87%E6%95%B0%E5%88%97 （HANA） 2014/08/18(月) 23:43
>> listtorihikisaki.Clear >で、なぜかエラーが発生してしまったので、 >listtorihikisaki.RowSource = "" を継続使用しました。なぜでしょう？？
リストボックスにメンバーを登録する方法は、いくつかの方法があります。 RowSourceプロパティにセルアドレスを指定する方法もその一つですが、 変化しないひとつのセル範囲をデータとして使用する場合は便利ですが、 今回のように検索した結果を登録する場合は、ちょっと不便です。
又、RowSourceでの登録の場合、Listbox.Clearがエラーになります。
>Private Sub UserForm_Initialize()
> Dim wLastGyou As Long
> '最終行番号を取得
> wLastGyou = Worksheets("コード表").UsedRange.Rows.Count
> 'リストボックスに「コード表」のリストをセット
> With listtorihikisaki
> '列の指定：3列とする
> .ColumnCount = 3
> '見出しの設定：無し
> .ColumnHeads = False
> 'リストボックスの値にセルC2からD最終行までセット
.list() = Worksheets("コード表").range("B2:D" & wLastGyou).value
> End With
>End Sub
としてみてください。
そうすれば、Listbox1.Clearでエラーになりません。 今回は、こっちの方が良さそうですよ！！
いくつもあるリストボックスにメンバーを登録する方法の一つの例です。
新規ブックを作成してください（Sheet1というシート名が存在するブックです）。
Sheet1に以下のようなサンプルデータを用意してください。
Ａ Ｂ Ｃ Ｄ Ｅ 1 会員番号 氏名 出身 血液型 備考 2 1 奥田 美香 東京都 Ａ型 週間文春タバコフォーカス事件にて脱退 3 2 榎田 道子 東京都 ＡＢ型 週間文春タバコフォーカス事件にて脱退 4 3 吉野 佳代子 埼玉県 Ｏ型 週間文春タバコフォーカス事件にて脱退 5 4 新田 恵利 埼玉県 Ｏ型 初期メンバーの中で最も活躍。在籍中にボンド／キャニオンからソロデビュー 6 5 中島 美春 東京都 Ａ型 「なかじ」の愛称で親しまれる 7 6 樹原亜紀 神奈川県 ＡＢ型 ニャンギラスの一員として活躍。妙に背が高い 8 7 友田 麻美子 東京都 Ａ型 週間文春タバコフォーカス事件にて脱退。
データは、以下より引用しました。 http://www2.cc22.ne.jp/~micchan777/p/idol/idol021.html 因みに私は、おニャン子より前のオールナイターズの世代です。
ユーザーフォームを一つ作成してください（UserForm1）。
このUserForm1には、
リストボックス ListBox1
コマンドボタン CommandButton1
の二つのコントロールを貼り付けてください。
UserForm1のモジュールに
'=======================================================
Option Explicit
Const f_word = "東京都"
Private Sub CommandButton1_Click()
Dim rng As Range
Dim vr As Variant
Dim g0 As Long
Dim ll() As Variant
Dim cnt As Long
ListBox1.Clear
With Worksheets("sheet1")
Set rng = .Range("a2", .Cells(.Rows.Count, "a").End(xlUp))
End With
If rng.Row > 1 Then
cnt = 0
vr = rng.Resize(, 3).Value
For g0 = LBound(vr, 1) To UBound(vr, 1)
If vr(g0, 3) = f_word Then
cnt = cnt + 1
ReDim Preserve ll(1 To 3, 1 To cnt)
ll(1, cnt) = vr(g0, 1)
ll(2, cnt) = vr(g0, 2)
ll(3, cnt) = vr(g0, 3)
End If
Next
If cnt > 0 Then
With ListBox1
.ColumnCount = 3
.ColumnWidths = "50;200;300"
.Column() = ll()
End With
End If
End If
End Sub
標準モジュールに
'==============================================
Option Explicit
Sub sample()
UserForm1.Show
End Sub
sampleを実行すると、UserForm1が表示されます。コマンドボタンのクリックで Sheet1のデータから、出身が 東京都の会員だけリストボックスに表示します。
調べてみてください
リストボックスで選択したメンバのリストボックスに表示されているデータ以外も 必要なら あと一つリストボックスにデータを登録すると便利そうですが・・・。
（ichinose@明日から、また仕事） 2014/08/19(火) 05:03
調べてみて、コードを書き換えて、「うまくいった！！」と思ったのですが、
そうは甘く無かったです。。
検索結果が複数ある場合、1つ目は3列思うように表示されたのですが、2つ目以降が、3列表示されません。
良いところまで行ってると思うので、あと少しアドバイスを頂ければと思います。
Private Sub Textkensaku_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim Obj As Object
Dim wAddST As Variant
Dim wAddress As Variant
Dim wtorihikisaki As Variant
'検索範囲を設定
With Worksheets("コード表").Columns(4)
'テキストボックスの値が含まれるセルを検索
Set Obj = .Cells.Find( _
What:=Textkensaku.Value, _
LookIn:=xlValues, _
lookat:=xlPart, _
MatchByte:=False)
'検索対象がない場合はメッセージを表示
If Obj Is Nothing Then
MsgBox "対象科目は存在しません。", _
vbOKOnly + vbInformation, "検索"
Else
'リストボックスをクリア
listtorihikisaki.RowSource = ""
'検索にヒットした先頭のセルのアドレスをセット
wAddST = Obj.Address
'検索の繰り返し処理
Do
'リストボックスに追加
With listtorihikisaki
.AddItem Obj.Offset(0, -2).Value
.List(0, 1) = Obj.Offset(0, -1).Value
.List(0, 2) = Obj.Value
End With
'次の検索を行う
Set Obj = .Cells.FindNext(Obj)
'最初にヒットしたアドレスと同じ場合は処理を終了
If Obj.Address = wAddST Then Exit Do
Loop
listtorihikisaki.ListIndex = 0
End If
End With
End Sub
（ゆり） 2014/08/19(火) 23:06
＞2つ目以降が、3列表示されません。 その時、どこに表示されているか確認出来てますか？
2列目以降は先頭行のデータが上書きされてないですか？
それは
.List(0, 1) = Obj.Offset(0, -1).Value
ここの所／~ で、0番目の行に書き込む様に指示がある為です。
Webで探してもらうと、今回なさりたい事の様に ループで回しながらデータを追加していく場合の書き方 が書いてあるページがあると思いますので、探してみて下さい。 （HANA） 2014/08/20(水) 14:28
コードを変えたら、思うように表示することができました。
その他のところで、まだまだ、うまくいかないところがありますので、
つまづいたらまた質問させて頂きます。
（たぶん、すぐにつまづくと思いますが・・・）
（ゆり） 2014/08/21(木) 22:18
無事できましたか、良かったです。
この掲示板は、ご質問者さんの問題を解決するためにもありますが 同じことをやりたい人のためにもあります。 ゆりさんも、過去ログ参考にしてませんか？ 探してもらうと、案外 似たような質問があったりしますよ。
＞コードを変えたら、思うように表示することができました。 だけでなく、どのように変更したのか 載せておいてもらうと良いと思います。 （HANA） 2014/08/21(木) 22:47
最終行を指定するコードを教えてもらえると助かります。
また、検索対象が無い場合、ﾃｷｽﾄﾎﾞｯｸｽ（Textkensaku）の文字を消し、カーソルをﾃｷｽﾄﾎﾞｯｸｽに移動させたいのですが、カーソルの移動がうまくいきません。
Textkensaku.Value = "" の後に、Textkensaku.SetFocus と入れても、ﾃｷｽﾄﾎﾞｯｸｽにカーソルが移動しません。ﾃｷｽﾄﾎﾞｯｸｽのプロパティで TabStop :true ,TabIndex:0 も設定してあります。
どのようにすれば、ﾃｷｽﾄﾎﾞｯｸｽにカーソルが移動するでしょうか。
Private Sub Textkensaku_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim Obj As Object
Dim wAddST As Variant
Dim wAddress As Variant
Dim wtorihikisaki As Variant
Dim i As Long
'検索範囲を設定
With Worksheets("コード表").Columns(4)
'テキストボックスの値が含まれるセルを検索
Set Obj = .Cells.Find( _
What:=Textkensaku.Value, _
LookIn:=xlValues, _
lookat:=xlPart, _
MatchByte:=False)
'検索対象がない場合はメッセージを表示
If Obj Is Nothing Then
MsgBox "対象科目は存在しません。", _
vbOKOnly + vbInformation, "検索"
Textkensaku.Value = ""
Else
'リストボックスをクリア
listtorihikisaki.Clear
'検索にヒットした先頭のセルのアドレスをセット
wAddST = Obj.Address
'検索の繰り返し処理
Do
'リストボックスに追加
For i = 0 To 1000
With listtorihikisaki
.AddItem Obj.Offset(0, -2).Value
.List(i, 1) = Obj.Offset(0, -1).Value
.List(i, 2) = Obj.Value
End With
'次の検索を行う
Set Obj = .Cells.FindNext(Obj)
'最初にヒットしたアドレスと同じ場合は処理を終了
If Obj.Address = wAddST Then Exit Do
Next
Loop
listtorihikisaki.ListIndex = 0
End If
End With
（ゆり） 2014/08/22(金) 21:59
2014/08/18(月) 23:43 の書き込み時に、グーグルの検索結果のページをリンクしましたが 現在上から2番目にある http://officetanaka.net/excel/vba/tips/tips158.htm は見ましたか？ 画像がリンク切れしていますが、文章とコードは確認できますので 見てもらえたらと思います。
それから、ichinoseさんがコメント下さってますが どうでしたか？ （HANA） 2014/08/22(金) 22:46
教えて頂いたコードを利用させて頂いた結果、Listbox1.Clear で問題なく実行できました。
ありがとうございました。
（ゆり） 2014/08/23(土) 22:44
過去ログで似たような質問があったので試してみたのですが、うまくいきませんでした。
申し訳ありませんが、どなたか教えて頂ければと思います。
ユーザーフォームのコード
'検索フォームを開いた時の処理
Private Sub UserForm_Initialize()
Textkensaku.SetFocus
Dim wLastGyou As Long
'最終行番号を取得
wLastGyou = Worksheets("コード表").UsedRange.Rows.Count
'リストボックスに「コード表」のリストをセット
With listtorihikisaki
'列の指定：3列とする
.ColumnCount = 3
'見出しの設定：無し
.ColumnHeads = False
'リストボックスの値にセルC2からD最終行までセット
.List() = Worksheets("コード表").Range("B2:N" & wLastGyou).Value
End With
End Sub
'検索用のテキストボックス更新後の処理
Private Sub Textkensaku_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim Obj As Object
Dim wAddST As Variant
Dim wAddress As Variant
Dim wtorihikisaki As Variant
Dim i As Long
'検索範囲を設定
With Worksheets("コード表").Columns(4)
'テキストボックスの値が含まれるセルを検索
Set Obj = .Cells.Find( _
What:=Textkensaku.Value, _
LookIn:=xlValues, _
lookat:=xlPart, _
MatchByte:=False)
'検索対象がない場合はメッセージを表示
If Obj Is Nothing Then
MsgBox "対象科目は存在しません。", _
vbOKOnly + vbInformation, "検索"
Textkensaku.Value = ""
Else
'リストボックスをクリア
listtorihikisaki.Clear
'検索にヒットした先頭のセルのアドレスをセット
wAddST = Obj.Address
'検索の繰り返し処理
Do
'リストボックスに追加
For i = 0 To Cells(Rows.Count, 1).End(xlDown).Row
With listtorihikisaki
.AddItem Obj.Offset(0, -2).Value
.List(i, 1) = Obj.Offset(0, -1).Value
.List(i, 2) = Obj.Value
.List(i, 3) = Obj.Offset(0, 1).Value
.List(i, 4) = Obj.Offset(0, 2).Value
.List(i, 5) = Obj.Offset(0, 3).Value
.List(i, 6) = Obj.Offset(0, 4).Value
.List(i, 7) = Obj.Offset(0, 5).Value
.List(i, 8) = Obj.Offset(0, 6).Value
.List(i, 9) = Obj.Offset(0, 7).Value
.List(i, 10) = Obj.Offset(0, 8).Value
.List(i, 11) = Obj.Offset(0, 9).Value
.List(i, 12) = Obj.Offset(0, 10).Value
End With
'次の検索を行う
Set Obj = .Cells.FindNext(Obj)
'最初にヒットしたアドレスと同じ場合は処理を終了
If Obj.Address = wAddST Then Exit Do
Next
Loop
listtorihikisaki.ListIndex = 0
End If
End With
End Sub
（ゆり） 2014/09/04(木) 22:11
単純に、UserForm_Initializeの所でリストを表示させる作業を 「対象科目は存在しません。」の時にやるのではだめなのでしょうか？ （HANA） 2014/09/05(金) 09:35
「対象科目は存在しません。」の時は、ﾘｽﾄﾎﾞｯｸｽはそのまま全データが表示されています。
一回検索が終わり、ﾃｷｽﾄﾎﾞｯｸｽの文字をdeleteして、違う文字を入力し再検索をかける時など、今のコードでは対応出来ておりません。
可能であれば、下記のような形で出来ればなーっと思っております。
ﾘｽﾄﾎﾞｯｸｽ： ｱｶｻﾀﾅ
ｱｶｻ
ｱｶ
ｱ
ﾃｷｽﾄﾎﾞｯｸｽ： " ｱｶｻ "を入力
ﾘｽﾄﾎﾞｯｸｽ： ｱｶｻﾀﾅ
ｱｶｻ
↓
ﾃｷｽﾄﾎﾞｯｸｽ： ｻをdeleteする
ﾘｽﾄﾎﾞｯｸｽ： ｱｶｻﾀﾅ
ｱｶｻ
ｱｶ
↓
ﾃｷｽﾄﾎﾞｯｸｽ： 文字delete
ﾘｽﾄﾎﾞｯｸｽ： ｱｶｻﾀﾅ
ｱｶｻ
ｱｶ
ｱ
（ゆり） 2014/09/06(土) 21:57
ですから、 UserForm_Initialize の中に 'リストボックスに「コード表」のリストをセット が有ります。
ここが、リストボックスに「コード表」の全てのリストをセットする所だと思いますので 単純に、このコードを Textkensaku_BeforeUpdate の方にも入れてしまえば良いと思うのですが それではうまくいかなかったり、何か気になる点がありますか？
今の Textkensaku_BeforeUpdate の中には UserForm_Initialize の中にある 'リストボックスに「コード表」のリストをセット 部分のコードは無いですよね？ （HANA） 2014/09/08(月) 08:14
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.