[[20060921133716]]　『簡易リストボックスの応用』（ヨネ）　ページの最後に飛ぶ

『簡易リストボックスの応用』（ヨネ）

 こんにちは。以下のデータから簡易リストボックスの作り方で良い方法があれば教えてください。
 Sheet1に以下のようなデータがあるとします。

 Sheet1

	A	B	C
 1	分類	種類	産地
 2	果物	いちご	千葉
 3	果物	りんご	青森
 4	果物	りんご	長野
 5	果物	みかん	愛媛
 6	果物	みかん	静岡
 7	果物	マンゴー	沖縄
 8	果物	パパイヤ	沖縄
 9	野菜	きゅうり	千葉
 10	野菜	レタス	長野
 11	野菜	レタス	栃木
 12	肉	牛肉	山形
 13	肉	牛肉	兵庫
 14	肉	豚肉	鹿児島
 15	肉	豚肉	栃木
 16	肉	鶏肉	群馬

 Sheet2に

 セルA1 には 分類のリストとして
 果物、野菜、肉を 入力規則として設定したい。
 セルB1 には セルA1で選択したものの絞込みされた 種類のリストを出したい。
 例えば A1に 果物を 選択していたら
 B1には いちご、りんご、みかん、マンゴー、パパイヤ を入力規則として設定したい。
 セルC1 には セルA1,セルB1で選択したものの絞込みされた 産地のリストを出したい
 例えば A1に 果物、B1に りんごを 選択していたら
 C1には 青森、長野 を 入力規則として設定したい。

 こちらの
[[20040826180010]]　入力規制』（TK） 
 を参考に考えてみたのですが、わかりませんでした。
 よろしくお願い致します。

 項目別にリストを作成し、名前を定義します。
 産地は各品目に関連しているようなので、その品目毎に名前を定義します。
 ↓のようなリストにして、挿入→名前→作成で上端行で名前を定義します。
分類	果物	野菜	肉	いちご	りんご	みかん
果物	いちご	きゅうり	牛肉	千葉	青森	愛媛
野菜	りんご	レタス	豚肉		長野	静岡
肉	みかん		鶏肉			
	マンゴー					
	パパイヤ

 各セルにはデータ→入力規則で、リストの元の値に下のように指定します。
A1:=分類
B1:=INDIRECT(A1)
C1:=INDIRECT(B1)
　　　(Hatch)

 (Hatch)さんありがとうございます。
 ただ このSheet1のデータは、分類、種類、産地ともに今後、増えていくものなので
 事前にリストを作って置くことができないのです。
 Sheet1の状態から、一気にリストを作ることはできないでしょうか。(ヨネ)

 近くのスレで似たようなものを作ったのでちょっと編集してみました。
[[20060920215636]]『入力規則のリストに先頭が数字の名前が付けられない場合』（えでたか）

 Sheet2のシートタブを右クリックし、コードの表示を選択。
 出てきた画面に下記コードを貼り付けて閉じる。
 (ROUGE)
'----
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim tbl, i As Long, ky, lst As String
    With Target
        If .Count > 1 Then Exit Sub
        If .Row <> 1 Then Exit Sub
        If .Column > 3 Then Exit Sub
    End With
    With Sheets("Sheet1")                                           '<--ここ
        tbl = .Range("A2:C" & .Range("C" & Rows.Count).End(xlUp).Row)
    End With
    Select Case Target.Column
        Case 1
            With CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(tbl, 1)
                    If Not IsEmpty(tbl(i, 1)) And Not .exists(tbl(i, 1)) Then _
                        .Add tbl(i, 1), Empty
                Next
                If .Count > 0 Then
                    For Each ky In .Keys
                        lst = lst & "," & ky
                    Next
                Else
                    lst = ""
                End If
            End With
        Case 2
            If Target.Offset(, -1).Value = "" Then Exit Sub
            With CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(tbl, 1)
                    If tbl(i, 1) = Target.Offset(, -1).Value And Not IsEmpty(tbl(i, 2)) And _
                        Not .exists(tbl(i, 2)) Then _
                        .Add tbl(i, 2), Empty
                Next
                If .Count > 0 Then
                    For Each ky In .Keys
                        lst = lst & "," & ky
                    Next
                Else
                    lst = ""
                End If
            End With
        Case 3
            If Target.Offset(, -1).Value = "" Then Exit Sub
            With CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(tbl, 1)
                    If tbl(i, 1) = Target.Offset(, -2).Value And tbl(i, 2) = Target.Offset(, -1).Value _
                        And Not IsEmpty(tbl(i, 3)) And Not .exists(tbl(i, 3)) Then .Add tbl(i, 3), Empty
                Next
                If .Count > 0 Then
                    For Each ky In .Keys
                        lst = lst & "," & ky
                    Next
                Else
                    lst = ""
                End If
            End With
    End Select
    If lst = "" Then: Target.Validation.Delete: Target.Value = Empty: Exit Sub
    If InStr(1, lst, Target.Text) = 0 Then Target = Empty
    With Target.Validation
        .Delete
        .Add xlValidateList, , , lst
    End With
End Sub

 すごい！！できました(^○^)。感激です！
 どうもありがとうございました。（ヨネ）

コメント返信：

[ 一覧(最新更新順) ]

[[20060921133716]] 『簡易リストボックスの応用』（ヨネ） ページの最後に飛ぶ

[[20060921133716]]　『簡易リストボックスの応用』（ヨネ）　ページの最後に飛ぶ