エクセルのvbaでの検索について

質問

エクセルのvbaでの検索について

TextBox1 へ検索値を入れ、CommandButton1clickで結果を
ListBox1　へ表示するようにします
表示された結果をクリックすると、TextBox1～4へ各当行1,2,4,5を
表示させるにはどうしたら良いでしょうか？

　　A　　　　　B　　　　　C　　　　　D　　　　　E
1　番号　　　名前　　　出身　　　 趣味　　　年齢
2　0155　　　相談　　　大阪　　　 バイク　　25
3　0158　　　ホーム　　東京　　　バイク　　 28
4　0233　　　質問　　　名古屋　　車　　　　　24

検索場所はAで行い、「15」で検索した場合ListBox1の表示は
0155
0158
となるようにし、それぞれをクリックするとTextBox1～4へ
0155　相談　　バイク　25
0158　ホーム　バイク　28
と表示されるようにしたいです

回答No.6

hallo-2007

ゴールデンウェークなのに、やることもなく暇なのでもう一案
No2の方がおっしゃるとおり、私のコードは全ての行を条件にかけますので
＞流石に全セルを舐めて拾い上げるのは，ちょっと動作が無駄なんじゃないかな？という気はします。
の通りです。
もし、これが宿題とか問題であれば、最も回答が多いパターンでもう一歩と云ったところでしょう。
但し、これが会社の業務であって、データが1日に一度更新される内容を日々の問い合わせなどで活用するとかの目的であれば
１、データを更新した際に、昇順に並べ替えるVBAを組み込んでおきます。
（この作業はパソコンに負担となるかもしれませんが、一度です）
２、Textbox1には015とか左から順に検索したい値を入力します。
３、条件にあうデータの数と最初の行を検索して
４、条件にあったデータの数だけ繰り返し表示して終わり
と云った具合の運用ができればの話です。
Private Sub CommandButton1_Click()
ListBox1.Clear
c = WorksheetFunction.CountIf(Range("A:A"), TextBox1.Value & "*")
If c = 0 Then Exit Sub
k = Range("A:A").Find(What:=TextBox1.Value & "*").Row
For i = k To k + c - 1
ListBox1.AddItem Range("A" & i).Value
Next
End Sub

という発想もありかと思います。
いずれにしても、コードや動作させるアルゴリズムの前に
職場での運用が重要です。質問者にしかわからない部分でしょう。
＞＞絶対にダブリがないなら
＞これあるかもです・・・
これもあったらどうするかの前に、あってよいものかどうかです。
ダブりがあってはならない情報であるならば、ダブってしまう原因をつぶしていきます。

回答No.5

Wendy02

#3の件です。
>早速コピペして動かしたのですが、
>＞Ar = Application.Transpose(Ar)　型が一致しません
>となり、止まってしまいました・・・

私は、コピー＆ペーストで貼り付けて、そのまま動くようなつもりでコードは書いていません。

With Worksheets(1)　左端のシート

と、固定シートになっていますから、もし違うなら、そこを直せばよいし、その程度は、直せるレベルの方だと思って書いています。この周辺の話と、前回(#5867259)の回答のコードで、この部分は予測しています。おそらくは、ActiveSheet になるのかもしれませんが、シートが、2月、3月となっと時に、また処理を考えなくてはなりません。

前回の回答のコードの応用でしかありませんし、ここの回答で、すでに思い通りの最高のものがあるのなら、あえて私のものを直す必要もないと思います。

回答No.4

ka_na_de

おはようございます。

前回と今回の質問を拝見して、なぜオートフィルタを使わないのか
疑問でした。
実際に試してみると、EXCEL2007までは、オートフィルタの
フィルタオプションを使っても、数値に関しては、部分一致検索
ができないのですね。

EXCEL2010では、ここの機能が拡張されるようです。
http://officetanaka.net/excel/excel2010/018.htm

そこで、あえてリストボックスを介さずにオートフィルタ風に
データを絞り込むように作ってみました。
この方法ですと、B列C列を通常のオートフィルタでさらに
絞り込んでいく事も可能になります。

ちなみに、キーワードを何も入れずに検索すると全表示します。
Private Sub CommandButton1_Click()
　　Dim myCell As Range

　　Cells.EntireRow.Hidden = False
　　For Each myCell In Range("A2", Cells(Rows.Count, "A").End(xlUp))
　　　　If myCell.Value Like "*" & Range("G1").Value & "*" Then
　　　　　　myCell.EntireRow.Hidden = False
　　　　Else
　　　　　　myCell.EntireRow.Hidden = True
　　　　End If
　　Next myCell
End Sub

参考URL：

http://officetanaka.net/excel/excel2010/018.htm

回答No.3

Wendy02

イベントの説明は、前回のほうに書かれています。
今回のものは、前回の質問の回答と発想で出来ています。

テキストボックスの名称は、検索用が、TextBox1, 表示用は、TextBox2 ～ TextBox5
検索用のコマンドは、「15」ではなく、「15*」か、「15#」と入れます。(#は、任意の数字の意味)
オートフィルタでやっても良いかと思います。

Dim Ar3() As Variant 'モジュールの上部に置く
Private Sub CommandButton1_Click()
Dim i As Long, j As Long
Dim Ar As Variant
Dim Ar2() As Variant
Dim rng As Range
With Worksheets(1)
　Erase Ar3()
　Set rng = .Range("A2", .Cells(Rows.Count, 1))
　Ar = rng.Value
　Ar = Application.Transpose(Ar)
　For i = LBound(Ar) To UBound(Ar)
　　 If Ar(i) Like TextBox1.Value Then
　　　　ReDim Preserve Ar2(j)
　　　　ReDim Preserve Ar3(j)
　　　　Ar2(j) = rng.Cells(i, 1).Value
　　　　Ar3(j) = rng.Cells(i, 1).Value & vbTab & rng.Cells(i, 1).Value _
　　　　& vbTab & rng.Cells(i, 2).Value & vbTab & rng.Cells(i, 4).Value _
　　　　& vbTab & rng.Cells(i, 5).Value
　　　　j = j + 1
　　 End If
　Next
　If UBound(Ar2) > -1 Then
　 ListBox1.List = Ar2
　End If
End With
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
　Dim i As Long
　Dim j As Long
　　For i = 0 To ListBox1.ListCount - 1
　　　　If ListBox1.Selected(i) Then
　　　　　　 For j = 2 To 5 'TextBox2 ～TextBox5
　　　　　　　 If Me.Controls("TextBox" & j).Value = "" Then
　　　　　　　　　 Me.Controls("TextBox" & j).Value = Ar3(i)
　　　　　　　　　 ListBox1.RemoveItem i
　　　　　　　　　 Exit Sub
　　　　　　　 End If
　　　　　　 Next
　　　　End If
　　Next
End Sub

補足

色々なスタイルの回答ありがとうです
早速コピペして動かしたのですが、
＞Ar = Application.Transpose(Ar)　型が一致しません
となり、止まってしまいました・・・
どうしたら良いかも分からずお手上げです

回答No.2

keithin

ん？　なんだろう。
ついさっきも，また昨日か一昨日などにも全く同じご相談が投稿されましたが，何かどこかの宿題か懸賞問題とかなんでしょうかね？

とりあえず先ほど解決した別の方のご相談投稿です。
http://oshiete1.nifty.com/qa5868539.html
＃流石に全セルを舐めて拾い上げるのは，ちょっと動作が無駄なんじゃないかな？という気はします。

＃また，番号列のセルの「具体的な書式設定と記入内容」によっては，マクロの方でもそれに合わせてやり方を変えないと行けない場合もあるかもしれません。実際にエクセルにデータを作成して，あたまにゼロ付きの番号数字をどういうやり方で記入した場合はどんなマクロで上手く行くのか行かないのか，ご自分で研究なさってみてください。

リストボックスで選んだのを拾い上げるのは，リストボックスでMultiSelectを許可しているのかいないのかなどによっても変わりますが，許可しないならListBoxのClickでもChangeでもどっちでも出来ます。

それで先のご相談ではタイミングが遅れて回答投稿できませんでしたが，元のリストの番号列に同じ番号のダブりは絶対に無いのかとかも，結構気になるポイントです。

絶対にダブりが無いなら状況は簡単で
private sub ListBox1_change()
　dim h as range
　set h = worksheets("Sheet1").range("A:A").find(what:=Listbox1.value)
　textbox1 = h
　textbox2 = h.offset(0,1)
　textbox3 = h.offset(0,3)
　textbox4 = h.offset(0,4)
end sub
とかで十分かと思います。

お礼

回答ありがとうです
＞絶対にダブリがないなら
これあるかもです・・・
仮にダブリがあるとしたら、何処か変更しないとダメでしょうか？

回答No.1

hallo-2007

ほんの先ほど同じような質問に回答しました
検索場所はAで行い、「15」で検索した場合ListBox1の表示は
0155
0158
となるようにし
は
http://okwave.jp/qa/q5868539.html
を参考にしてください。
それぞれをクリックするとTextBox1～4へ
も含めて
Private Sub CommandButton1_Click()
ListBox1.Clear
For i = 2 To Range("B65536").End(xlUp).Row
If Range("A" & i).Value Like "*" & TextBox1.Value & "*" Then
ListBox1.AddItem Range("A" & i).Value
End If
Next
End Sub

Private Sub ListBox1_Click()
TextBox2.Value = Range("A:A").Find(what:=ListBox1.Value).Offset(0, 1).Value
TextBox3.Value = Range("A:A").Find(what:=ListBox1.Value).Offset(0, 2).Value
TextBox4.Value = Range("A:A").Find(what:=ListBox1.Value).Offset(0, 3).Value
End Sub
では如何でしょうか？
但し
1　番号　　　名前　　　出身　　　 趣味　　　年齢
2　0155　　　相談　　　大阪　　　 バイク　　25
3　0158　　　ホーム　　東京　　　バイク　　 28
4　1533　　　質問　　　名古屋　　車　　　　　24
とあって15で検索した場合に4行目も表示されますが。

お礼

ありがとうです
思い通りに動いて最高です