[[20090625095850]]　『リストボックスを使った検索方法について』（えくせる）　ページの最後に飛ぶ

『リストボックスを使った検索方法について』（えくせる）

 エクセルで作成したデータについて、リストボックスで検索したい
 のですが、下記の場合、どのようにＶＢＡを組めばいいでしょうか？

 Ａ列　　　　　Ｂ列　　　　　　Ｃ列　　　　　Ｄ列
　兵庫県　　　りんご　　　　　　赤　　　　　　１万円
  大阪府　　　みかん　　　　　　橙　　　　　　5,000円
  奈良県　　　りんご　　　　　　青　　　　　　２万円
  ・・・

 このようなデータがある場合に、ユーザーフォーム（リストボックスを配置）を
 ４つ作って下記検索を行う場合のＶＢＡ
 ユーザーフォーム１・・・Ａ列の検索条件（兵庫県、大阪府、奈良県等）から選択）
 ユーザーフォーム２・・・Ｂ列の検索条件から選択
 ユーザーフォーム３・・・Ｃ列の検索条件から選択
 ユーザーフォーム４・・・Ｄ列の検索条件（○円以上、○円以下）で選択

 こういうのは可能でしょうか？
 ユーザーフォーム４自体は難しいかもしれませんが、ＶＢＡを教えていただければ
 助かります。

 よろしくお願いします。

 オートフィルタを設定しておいて

 '------
Sub 先頭項目()
    Application.ExecuteExcel4Macro "FILTER?(1,"""")"
End Sub
 '------

 なんてのは？

 (HANA)

 hanaさん、ありがとうございます。
 すいません、やり方が全くわからずすいません。
 やろうとしてるのはボタンを押すとユーザーフォーム１に
 飛んで、リストボックスから一つ目の項目を選ぶ、その後
 リストボックス２へ・・・でリストボックス４の項目を選んだ
 ら抽出データのみが出てくるといったイメージです。

 すいませんが、具体的に教えてもらえたら助かります。
 初歩的な質問ばかりですいません。

 もっと仕様を詰める必要が有りそうに思いますが。

 そのイメージなら・・・・
 新しいブックのSheet1に
 以下のようにデータを配置して下さい。
	[A]	[B]	[C]	[D]
[1]	県名	品名	色	金額
[2]	兵庫県	りんご	赤	10000
[3]	大阪府	みかん	橙	5000
[4]	奈良県	りんご	青	20000
[5]	兵庫県	りんご	青	10000
[6]	大阪府	みかん	橙	5000
[7]	奈良県	りんご	赤	20000
[8]	大阪府	みかん	橙	3000

 　ここからコピーして、形式を選択して貼り付け→テキスト
 　で貼り付け後、[1][A]の行列を削除してもらうと
 　簡単かもしれません。

 抽出コードと、全て表示のコードです。
 標準モジュールに貼り付けて、確認して下さい。

 '------
Sub 抽出()
Dim i As Long, Arng As Range
With Sheets("Sheet1")
    If .AutoFilterMode = True Then
        .AutoFilterMode = False
    End If
    .Range("A1:D1").AutoFilter
    Set Arng = Application.Intersect(.Range("A:A"), .AutoFilter.Range)
    For i = 1 To 4
        Application.ExecuteExcel4Macro "FILTER?(" & i & ","""")"
        If Application.Evaluate("SUBTOTAL(3," & Arng.Address & ")") - 1 < 2 Then
            Exit For
        End If
    Next
End With
Set Arng = Nothing
End Sub
 '------
Sub 全て表示()
With Sheets("Sheet1")
    If .AutoFilterMode = True Then
        .ShowAllData
    End If
End With
End Sub
 '------

 (HANA)

　hanaさん、ありがとうございます。

 イメージしてるのはこんな感じです。（別の抽出のＶＢＡが残って
 ましたので、記載します。ﾕｰｻﾞｰﾌｫｰﾑ2、5、6、7、8、9の６つのリスト
 ボックスからそれぞれ選んだデータのみを抽出するものです。）

【userform2】
Private Sub ListBox2_Click()

 End Sub
 Private Sub userform_activate()
 Sheets("マクロ").Select
 ListBox1.RowSource = "g10:g12"
 End Sub
 Private Sub listbox1_dblclick(ByVal cancel As MSForms.ReturnBoolean)
 Application.ScreenUpdating = False
 Sheets("マクロ").Select
 Range("a2").Select
 ActiveCell.Value = ListBox1.Value
 UserForm2.Hide
 UserForm5.Show
 End Sub

【userform5】

 Private Sub ListBox1_Click()
 End Sub
 Private Sub userform_activate()
 Sheets("マクロ").Select
 ListBox1.RowSource = "h10:h13"
 End Sub
 Private Sub listbox1_dblclick(ByVal cancel As MSForms.ReturnBoolean)
 Sheets("マクロ").Select
 Range("a3").Select
 ActiveCell.Value = ListBox1.Value
 UserForm5.Hide
 UserForm6.Show
 End Sub

【userform6】

 Private Sub ListBox1_Click()
 End Sub
 Private Sub userform_activate()
 Sheets("マクロ").Select
 ListBox1.RowSource = "i10:i13"
 End Sub
 Private Sub listbox1_dblclick(ByVal cancel As MSForms.ReturnBoolean)
 Sheets("マクロ").Select
 Range("i8").Select
 ActiveCell.Value = ListBox1.Value
 Sheets("マクロ").Select
 Range("j8:T8").Select
 Selection.ClearContents
 UserForm6.Hide
 Sheets("マクロ").Select
 ActiveSheet.Calculate
 UserForm7.Show
 End Sub

【userform7】

 Private Sub listbox1_dblclick(ByVal cancel 
 As MSForms.ReturnBoolean)
 Range("i7").Select
 If ActiveCell.Text = "1" Then
    Sheets("マクロ").Select
    Range("j8").Select
    ActiveCell.Value = ListBox1.Value
 ElseIf ActiveCell.Text = "2" Then
    Sheets("マクロ").Select
    Range("n8").Select
    ActiveCell.Value = ListBox1.Value
 ElseIf ActiveCell.Text = "3" Then
    Sheets("マクロ").Select
    Range("r8").Select
    ActiveCell.Value = ListBox1.Value
    End If
 UserForm7.Hide
Sheets("マクロ").Select
ActiveSheet.Calculate
Range("j7").Select
 If ActiveCell.Text = "1" Then
 UserForm8.Show
 ElseIf ActiveCell.Text = "2" Then
 UserForm8.Show
 ElseIf ActiveCell.Text = "3" Then
 Macro200
 ElseIf ActiveCell.Text = "4" Then
 Macro200
    End If
Range("n7").Select
 If ActiveCell.Text = "1" Then
 UserForm8.Show
 ElseIf ActiveCell.Text = "2" Then
 UserForm8.Show
 ElseIf ActiveCell.Text = "3" Then
 UserForm8.Show
 ElseIf ActiveCell.Text = "4" Then
 UserForm8.Show
 ElseIf ActiveCell.Text = "5" Then
 UserForm8.Show
    End If
Range("r7").Select
 If ActiveCell.Text = "1" Then
 UserForm8.Show
 ElseIf ActiveCell.Text = "2" Then
 UserForm8.Show
     End If
End Sub

【userform8】

 Private Sub listbox1_dblclick(ByVal cancel 
 As MSForms.ReturnBoolean)
 Range("j7").Select
 If ActiveCell.Text = "1" Then
    Sheets("マクロ").Select
    Range("k8").Select
    ActiveCell.Value = ListBox1.Value
 ElseIf ActiveCell.Text = "2" Then
    Sheets("マクロ").Select
    Range("l8").Select
    ActiveCell.Value = ListBox1.Value
    End If
Range("n7").Select
 If ActiveCell.Text = "1" Then
    Sheets("マクロ").Select
    Range("o8").Select
    ActiveCell.Value = ListBox1.Value
 ElseIf ActiveCell.Text = "2" Then
    Sheets("マクロ").Select
    Range("p8").Select
    ActiveCell.Value = ListBox1.Value
 ElseIf ActiveCell.Text = "3" Then
    Sheets("マクロ").Select
    Range("o8").Select
    ActiveCell.Value = ListBox1.Value
 ElseIf ActiveCell.Text = "4" Then
    Sheets("マクロ").Select
    Range("p8").Select
    ActiveCell.Value = ListBox1.Value
 ElseIf ActiveCell.Text = "5" Then
    Sheets("マクロ").Select
    Range("o8").Select
    ActiveCell.Value = ListBox1.Value
    End If
Range("r7").Select
 If ActiveCell.Text = "1" Then
    Sheets("マクロ").Select
    Range("s8").Select
    ActiveCell.Value = ListBox1.Value
 ElseIf ActiveCell.Text = "2" Then
    Sheets("マクロ").Select
    Range("t8").Select
    ActiveCell.Value = ListBox1.Value
     End If
 UserForm8.Hide
     Sheets("マクロ").Select
    ActiveSheet.Calculate
    Range("i7").Select
    If ActiveCell.Text = "1" Then
     Macro101
    ElseIf ActiveCell.Text = "2" Then
     Macro102
    ElseIf ActiveCell.Text = "3" Then
     Macro103
    End If
End Sub

【userform9】

 Private Sub ListBox1_Click()
 End Sub
Private Sub userform_activate()
Sheets("マクロ").Select
ActiveSheet.Calculate
Range("k7").Select
 If ActiveCell.Text = "" Then
 Else
    Sheets("マクロ").Select
    ListBox1.RowSource = "m10:m16"
    End If
Range("o7").Select
 If ActiveCell.Text = "" Then
 Else
    Sheets("マクロ").Select
    ListBox1.RowSource = "q10:q16"
    End If
End Sub
Private Sub listbox1_dblclick(ByVal 
 cancel As MSForms.ReturnBoolean)
Sheets("マクロ").Select
Range("k7").Select
 If ActiveCell.Text = "" Then
 Else
    Sheets("マクロ").Select
    Range("m8").Select
    ActiveCell.Value = ListBox1.Value
    End If
Range("o7").Select
 If ActiveCell.Text = "" Then
 Else
 Sheets("マクロ").Select
    Range("q8").Select
    ActiveCell.Value = ListBox1.Value
    End If
 UserForm9.Hide
 Macro200
End Sub

 これだとユーザーフォームで抽出したデータのみが
 出てきます。（前任者の作なので、組み方は私には分からないです。）

 こういうのを作りたいのですが・・・。
 難しいでしょうか？

 コードを載せられて「こういうの」と言われても
 何がどうなっているのか分かりませんが。。。

 最初に言っておられたように
 　一つずつ　▼　候補の中から条件を選んでいって
 　最終的に絞り込んだ状態にする
 　（金額は範囲での抽出も可）
 ってのは、先のマクロでも出来ると思います。

 ＞難しいでしょうか？
 そうですね、色々な知識が必要と思いますよ。

 まずは、ご自身で作ってみて
 躓いたところを質問する形にした方が
 良いかもしれません。

 (HANA)

 ＨＡＮＡさん、すいません。
 うまく伝えられなくて・・・。
 最初に書かせてもらってますが、ボタンを押すと
 各ユーザーフォームが出てきてそのリストボックスから
 選んだものを抽出していけたらいいですが・・。
 （Ａ列－兵庫県を選択→Ｂ列 りんご　→Ｃ列赤・・・と
 選んだらそのデータだけが抽出される。。）

 最初に記載したものではイメージしにくいでしょうか？
 ２つめに書いたコード表は確かに分かりにくいと思いますが、
 最初に書いたＡ列、Ｂ列、Ｃ列・・・を各ユーザーフォーム
 に置き換えたらいい例えかなと思ったもので・・。

 分かりにくいかったらごめんなさい。
 もし他の方もいいアイデアがありましたら、よろしくお願いします。

 ＞最初に記載したものではイメージしにくいでしょうか？
 イメージは分かりますが、質問内容が大きすぎると思います。

 項目で一つ指定するたびに、次の候補を絞り込んでいく
 のは、こちらのご質問と似ている様に思いますので、ご参考に。
[[20081217082039]]『3つ以上のコンボボックス連携について』(Voume11）

 (HANA)

コメント返信：

[ 一覧(最新更新順) ]

[[20090625095850]] 『リストボックスを使った検索方法について』（えくせる） ページの最後に飛ぶ

[[20090625095850]]　『リストボックスを使った検索方法について』（えくせる）　ページの最後に飛ぶ