Results of 1 - 1 of about 8929 for リスト (0.007 sec.)
- [[20180609095822]]
- #score: 2746
- @digest: 842e9a6141619e363359e838466e9711
- @id: 76581
- @mdate: 2018-06-11T04:55:40Z
- @size: 20916
- @type: text/plain
- #keywords: skipflag (177126), listbox3 (79042), listbox2 (53890), criteria (53821), rowsource (45094), extract (44889), listbox1 (18009), 屋市 (17466), afterupdate (15226), 浜市 (13216), listindex (8862), criteriarange (7870), トボ (7226), 横浜 (7042), ス2 (6874), advancedfilter (6386), action (5499), 名古 (5356), 古屋 (5199), copytorange (5131), xlfiltercopy (4741), タオ (4737), unique (4577), リス (4542), トデ (4081), ス1 (3810), 期化 (3785), ボッ (3720), userform (3626), 京都 (3614), private (3478), ああ (3129)
- 『リストボックスの3連以上の連携』（らる）
別シートにAセルは都道府県名、Bセルには市区名、Cセルには区町名 と言ったようにリストを用意します リストボックスを3つ用意し、リストボックス1は都道府県選択、それに応じリストボックス市区2のリストが変動、次のリストボックス3も変わると言ったことがしたいのです ただし、Additemでソース上に記入するやり方はできます、ただソースコードが長くなってしまい、見づらくなります できれば、RowSourceで簡単に記入していきたいのですが、いまいちわからないです 因みに、ここのサイトのコンボボックスのやり方を参考にしてみましたが、3つ目の分岐がうまくいきません リストボックス2分岐条件でのcase の後ろに"○○市"のようにソースコードを記入するとエラーが出ます、また数字にすると3つ目は変化しないといったようなことになってしまいます 解決策がわかりません、よろしくおねがいします ＜ 使用 Excel:Excel2007、使用 OS:Windows8 ＞ ---- 今のコードを提示してみては? # フィルタオプションかなにかを併用すると良い気はしますが。 （γ） 2018/06/09(土) 10:44 ---- 別シートの表はA列にリストボックス1の内容 C,D,E列にはリストボックス2に入るA列に対応する内容を G列以降にはリストボックス3に入る内容を作っておいてます コードは以下の通り Private Sub ListBox1_Change() Dim sa As Integer With UserForm1 .ListBox2.Text = "" sa = .ListBox1.ListIndex Select Case sa Case 0 .ListBox2.RowSource = "sheet1!c1:c6" Case 1 .ListBox2.RowSource = "sheet1!d1:d6" Case 2 .ListBox2.RowSource = "sheet1!e1:e6" End Select End With End Sub Private Sub ListBox2_Change() Dim sb As Integer With UserForm1 .ListBox3.Text = "" sb = .ListBox2.ListIndex Select Case sb Case バインダー .ListBox3.RowSource = "sheet1!g1:g6" Case 色鉛筆 .ListBox3.RowSource = "sheet1!h1:h6" Case 筆箱 .ListBox3.RowSource = "sheet1!i1:i6" Case ボールペン .ListBox3.RowSource = "sheet1!j1:j6" Case 文庫 .ListBox3.RowSource = "sheet1!l1:l6" Case 専門書 .ListBox3.RowSource = "sheet1!m1:m6" Case 図鑑 .ListBox3.RowSource = "sheet1!n1:n6" Case マウス .ListBox3.RowSource = "sheet1!p1:p6" Case ディスプレー .ListBox3.RowSource = "sheet1!q1:q6" Case PC .ListBox3.RowSource = "sheet1!r1:r6" Case USBメモリー .ListBox3.RowSource = "sheet1!s1:s6" Case キーボード .ListBox3.RowSource = "sheet1!t1:t6" Case 5 .ListBox3.RowSource = "sheet1!u1:u6" End Select End With End Sub Private Sub UserForm_Activate() With UserForm1 .ListBox1.RowSource = "sheet1!a1:a6" .ListBox2.RowSource = "sheet1!c1:c6" .ListBox3.RowSource = "sheet1!l1:l6" End With End Sub Private Sub UserForm_Click() End Sub です これはあくまで、テストようであって本チャンは別に作る予定です （らる） 2018/06/09(土) 12:38 ---- 質問者さんの今の方式でよいと思いました。 ListBox2_ChangeのなかでListIndexを使っていますが、 それはValueの間違いなんだろうと思いますが。 それとは別に、こんな方法を考えてみました。 ># フィルタオプションかなにかを併用すると良い気はしますが。 などと書きましたので責任をとって、コードを書いて見ました。 データは以下のようなものとして、 これをもとに自動的に重複を除いたコードを抽出します。 使用しているコントロールは、以下の4つです。 ・CommandButton1 ・ListBox1 「地域」表示用 ・ListBox2 「区」 表示用 ・ListBox3 「町」 表示用 ・CommandButton1を押すことで、 ListBox1に地域の3種類（東京都、横浜市、名古屋市）を表示 ・ListBox1のいずれかを選択することで、これに対応する区の選択肢をListBox2に表示します。 ・以下同じ。 <<Sheet1>> ================================================== A B C D E F G 1 地域 区 町 2 地域 区 町 3 東京都 品川区 A 4 東京都 品川区 B 5 東京都 大田区 C 6 東京都 大田区 D 7 東京都 港区 E 8 東京都 港区 F 9 横浜市 中区 G 10 横浜市 中区 H 11 横浜市 保土ヶ谷区 I 12 横浜市 保土ヶ谷区 J 13 横浜市 西区 K 14 横浜市 西区 L 15 名古屋市 南区 M 16 名古屋市 南区 N 17 名古屋市 中村区 O 18 名古屋市 中村区 P 19 名古屋市 瑞穂区 Q 細かい説明はコードをご覧下さい。 Option Explicit Dim ws As Worksheet Dim target As Range Dim body As Range Dim criteria As Range Dim skipflag As Boolean ' ============================ Private Sub UserForm_Initialize() Set ws = Worksheets("Sheet1") Set target = ws.Range("A2").CurrentRegion 'フィルタオプションの範囲 Set body = Intersect(target, target.Offset(1)) '見出しを除く本体部分 Set criteria = ws.Range("E1:G2") '検索条件範囲（見出しと値両方が必要） Application.ScreenUpdating = False skipflag = False End Sub ' ============================ Private Sub CommandButton1_Click() Dim r As Range With ws On Error Resume Next .ShowAllData On Error GoTo 0 'フィルタオプションの検索条件の値を初期化 criteria.Rows(2).ClearContents '最初のアイテムを対象に、重複を無視して抽出 target.Resize(, 1).AdvancedFilter Action:=xlFilterInPlace, _ CriteriaRange:=criteria.Resize(, 1), Unique:=True '初期化 skipflag = True 'changeの動作をスキップするため ListBox1.Clear skipflag = False '結果をListBox1に設定 For Each r In body.Columns(1).SpecialCells(xlCellTypeVisible) ListBox1.AddItem r.Value Next End With End Sub ' ============================ Private Sub ListBox1_Change() Dim r As Range If skipflag Then Exit Sub With ws On Error Resume Next .ShowAllData On Error GoTo 0 criteria.Cells(2, 1).Value = ListBox1.Value criteria.Cells(2, 2).Resize(1, 2).ClearContents target.Resize(, 2).AdvancedFilter Action:=xlFilterInPlace, _ CriteriaRange:=criteria.Resize(, 1), Unique:=True skipflag = True ListBox2.Clear ListBox3.Clear skipflag = False For Each r In body.Columns(2).SpecialCells(xlCellTypeVisible) ListBox2.AddItem r.Value Next End With End Sub ' ============================ Private Sub ListBox2_Change() Dim r As Range If skipflag Then Exit Sub With ws On Error Resume Next .ShowAllData On Error GoTo 0 criteria.Cells(2, 1).Value = ListBox1.Value criteria.Cells(2, 2).Value = ListBox2.Value target.AdvancedFilter Action:=xlFilterInPlace, _ CriteriaRange:=criteria.Resize(, 2), Unique:=True skipflag = True ListBox3.Clear skipflag = False For Each r In body.Columns(3).SpecialCells(xlCellTypeVisible) ListBox3.AddItem r.Value Next End With End Sub なにかゴテゴテしている感じかもしれません。ほんのご参考まで。 （γ） 2018/06/10(日) 08:27 ---- 今回の質問はVBAのようですので、向いてないのかもですが「都道府県」を選択したら「市町村」の候補が連騰して変化・・というのは、入力規則でも可能です。 http://liginc.co.jp/177947 https://excel-hack.com/beginner/pulldown-menu-interlock/ 興味があれば研究してみるのもいいかもです。 （もこな2） 2018/06/10(日) 08:43 ---- γさんのアイデア及びコードを少しいじってみました。（改悪?） 手作業で事前準備することで、 コード自体は多少コンパクトにできるかもしれません。 いずれにしてもフィルタオプションに使い慣れていないと 何をしているか理解しにくいかも。 1）シート構成は、γさんと同じでよいです 実際は、H〜J列を作業列として使い リスト作成用のデータを抽出しています。 2）CommandButton1は使いませんでした。 3）事前に名前定義（自動でデータ範囲を取得しています） field1:=OFFSET(Sheet1!$H$2,0,0,COUNTA(Sheet1!$H:$H),1) field2:=OFFSET(Sheet1!$I$2,0,0,COUNTA(Sheet1!$I:$I),1) field3:=OFFSET(Sheet1!$J$2,0,0,COUNTA(Sheet1!$J:$J),1) Option Explicit Dim ws As Worksheet Dim target As Range Dim criteria As Range Dim extract As Range Dim skipflag As Boolean ' ============================ Private Sub UserForm_Initialize() Set ws = Worksheets("Sheet1") Set target = ws.Range("A2").CurrentRegion 'フィルタオプションの範囲 Set criteria = ws.Range("E1:F2") '検索条件範囲（見出しと値両方が必要） Set extract = ws.Range("H1:J1") '抽出範囲（リスト作成の作業列） Dim r As Range With ws 'フィルタオプションの検索条件の値を初期化 criteria.Rows(2).ClearContents '初期化 skipflag = True 'changeの動作をスキップするため '最初のアイテムを対象に、重複を無視して抽出 target.Rows(1).Copy extract target.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=criteria, CopyToRange:=extract.Cells(1, 1), Unique:=True ListBox1.RowSource = "field1" ListBox2.RowSource = "" ListBox3.RowSource = "" skipflag = False End With End Sub ' ============================ Private Sub ListBox1_Change() Dim r As Range If skipflag Then Exit Sub With ws criteria.Cells(2, 1).Value = ListBox1.Value criteria.Cells(2, 2).ClearContents skipflag = True target.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=criteria, CopyToRange:=extract.Cells(1, 2), Unique:=True ListBox2.RowSource = "field2" ListBox2.ListIndex = -1 ListBox3.RowSource = "" skipflag = False End With End Sub ' ============================ Private Sub ListBox2_Change() Dim r As Range If skipflag Then Exit Sub With ws criteria.Cells(2, 2).Value = ListBox2.Value skipflag = True target.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=criteria, CopyToRange:=extract.Cells(1, 3), Unique:=True ListBox3.RowSource = "field3" skipflag = False End With End Sub （マナ） 2018/06/10(日) 15:13 ---- 私もちょっと考えてみました。 > 別シートの表はA列にリストボックス1の内容 > C,D,E列にはリストボックス2に入るA列に対応する内容を > G列以降にはリストボックス3に入る内容を作っておいてます データの持ち方は、質問者さんの上記の方法に、ちょっとアレンジを加えて、 <<Sheet1>> ========================================== A B C D E F G H 1 リスト1 あああ いいい ううう あああ1 あああ2 2 あああ あああ1 いいい1 ううう1 あああ11 あああ21 3 いいい あああ2 いいい2 ううう2 あああ12 あああ22 4 ううう あああ3 いいい3 ううう3 あああ13 あああ23 5 あああ4 いいい4 ううう4 あああ14 あああ24 6 あああ5 いいい5 ううう5 あああ15 あああ25 7 あああ6 いいい6 ううう6 あああ16 あああ26 A列の2行目からリストボックス1のリストデータ C,D,E列にはリストボックス2に入るリストデータですが、1行目はA列の内容を縦横変換して 貼り付けしておきます。データは2行目からです。 G列以降はリストボックス3のリストデータですが、同じく1行目はリストボックス2のデータです。 こういう形式にしておけば、データ内容をチェックするときも見やすいでしょう。 Private Sub ListBox1_AfterUpdate() Dim r As Range Me.ListBox2.ListIndex = -1 With Worksheets("Sheet1") Set r = .Range("C1").CurrentRegion.Rows(1).Find(What:=Me.ListBox1.Value) Set r = .Range(r.Offset(1), r.End(xlDown)) Me.ListBox2.RowSource = "Sheet1!" & r.Address End With Me.ListBox3.RowSource = "" End Sub Private Sub ListBox2_AfterUpdate() Dim r As Range Me.ListBox3.ListIndex = -1 With Worksheets("Sheet1") Set r = .Range("G1").CurrentRegion.Rows(1).Find(What:=Me.ListBox2.Value) Set r = .Range(r.Offset(1), r.End(xlDown)) Me.ListBox3.RowSource = "Sheet1!" & r.Address End With End Sub （hatena） 2018/06/10(日) 15:44 ---- データの持ち方は前の回答と同じで、RowSource に設定するセル範囲に名前を定義してみました。 コードがさらにシンプルになり、かつデータを追加、削除してもコードを変更する必要はありません。 Private Sub ListBox1_AfterUpdate() Me.ListBox2.ListIndex = -1 Me.ListBox2.RowSource = Me.ListBox1.Value Me.ListBox3.RowSource = "" End Sub Private Sub ListBox2_AfterUpdate() Me.ListBox3.ListIndex = -1 Me.ListBox3.RowSource = Me.ListBox2.Value End Sub Private Sub UserForm_Initialize() Dim r As Range, i As Long Dim n As Name '定義された名前をすべて削除 For Each n In Names n.Delete Next With Worksheets("Sheet1") 'すべてのリストデータに1行目の値を名前として定義する。 For i = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column Set r = .Cells(1, i) If r.Value <> "" Then r.Offset(1).Resize(r.End(xlDown).Row - 1).Name = r.Value End If Next Me.ListBox1.RowSource = .Cells(1, 1).Value End With End Sub （hatena） 2018/06/10(日) 16:40 ---- マナさん コード提供ありがとうございました。 参考にさせていただきます。 私の出発点は、 「提示した表を加工せず、自動で（しかも毎回!）リストボックスの要素を 抽出すること」にありましたので、フィルタオプションに淫したものになってしまいました。 加えて、当初のコードが間違った抽出（重複あり）の結果を返したものですから、 そのバグつぶしにヤッキになっていました（Clearに伴う再入処理のせいでした）。 したがいまして、質問者さんは私のものはうっちゃってくださいね。 （私の回答の際、冒頭にそれらしき雰囲気のことを書いているはずです。） 他の皆様からの適切な回答に注力してください。 （γ） 2018/06/10(日) 20:04 ---- 使ってない変数とかおかしなことろがあったので修正しました。 Option Explicit Dim target As Range Dim criteria As Range Dim extract As Range Dim skipflag As Boolean ' ============================ Private Sub UserForm_Initialize() Dim ws As Worksheet Set ws = Worksheets("Sheet1") Set target = ws.Range("A2").CurrentRegion 'フィルタオプションの範囲 Set criteria = ws.Range("E1:F2") '検索条件範囲（見出しと値両方が必要） Set extract = ws.Range("H1:J1") '抽出範囲（リスト作成の作業列） 'フィルタオプションの検索条件の値を初期化 criteria.Rows(2).ClearContents '初期化 skipflag = True 'changeの動作をスキップするため '最初のアイテムを対象に、重複を無視して抽出 target.Rows(1).Copy extract target.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=criteria, CopyToRange:=extract.Cells(1, 1), Unique:=True ListBox1.RowSource = "field1" ListBox2.RowSource = "" ListBox3.RowSource = "" skipflag = False End Sub ' ============================ Private Sub ListBox1_Change() If skipflag Then Exit Sub criteria.Cells(2, 1).Value = ListBox1.Value criteria.Cells(2, 2).ClearContents skipflag = True target.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=criteria, CopyToRange:=extract.Cells(1, 2), Unique:=True ListBox2.RowSource = "field2" ListBox2.ListIndex = -1 ListBox3.RowSource = "" skipflag = False End Sub ' ============================ Private Sub ListBox2_Change() If skipflag Then Exit Sub criteria.Cells(2, 2).Value = ListBox2.Value target.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=criteria, CopyToRange:=extract.Cells(1, 3), Unique:=True ListBox3.RowSource = "field3" End Sub （マナ） 2018/06/10(日) 23:08 ---- 前回の回答のコードで、名前定義をすべて削除していましたが、他のシートでも名前定義を使用している場合、それも削除してしまうので、リストデータのあるシート上だけ削除するように修正しました。 また、名前の設定を CreateNamesメソッドを使用する方法に変更しました。（そのほうが若干シンプルになる） Private Sub ListBox1_AfterUpdate() Me.ListBox2.ListIndex = -1 Me.ListBox2.RowSource = Me.ListBox1.Value Me.ListBox3.RowSource = "" End Sub Private Sub ListBox2_AfterUpdate() Me.ListBox3.ListIndex = -1 Me.ListBox3.RowSource = Me.ListBox2.Value End Sub Private Sub UserForm_Initialize() Dim r As Range, i As Long Dim n As Name 'Sheet1上の定義された名前をすべて削除 For Each n In Names If n.RefersToRange.Parent.Name = "Sheet1" Then n.Delete Next With Worksheets("Sheet1") 'すべてのリストデータに1行目の値を名前として定義する。 For i = 1 To .Cells(1, Columns.Count).End(xlToLeft).Column Set r = .Cells(1, i) If r.Value <> "" Then 'r.Offset(1).Resize(r.End(xlDown).Row - 1).Name = r.Value r.Resize(r.End(xlDown).Row).CreateNames Top:=True End If Next Me.ListBox1.RowSource = .Cells(1, 1).Value End With End Sub （hatena） 2018/06/11(月) 11:33 ---- データの形が最初の質問のようにA列、B列、C列の3列に並んでいる場合のコードも考えてみました。 この場合、まず重複の排除をどうするかですね。 AdvancedFilter を使用する方法は、γさん、マナさんからすでに回答がありますので、 Dictionaryオブジェクトを使う方法でやってみました。 2行目に項目名、3行目からデータがあるとします。 Option Explicit Dim Dic As New Dictionary Private Sub ListBox1_AfterUpdate() Me.ListBox2.ListIndex = -1 Me.ListBox2.List = Dic(Me.ListBox1.Value).Keys Me.ListBox3.Clear End Sub Private Sub ListBox2_AfterUpdate() Me.ListBox3.ListIndex = -1 Me.ListBox3.List = Split(Trim(Dic(Me.ListBox1.Value)(Me.ListBox2.Value))) End Sub Private Sub UserForm_Initialize() Dim rng As Range, v() As Variant, buf As String Dim r As Long With Worksheets("Sheet2") v = .Range("A2").CurrentRegion.Value For r = 2 To UBound(v) buf = v(r, 1) If Not Dic.Exists(buf) Then Dic.Add buf, New Dictionary Dic(buf)(v(r, 2)) = v(r, 3) Else Dic(buf)(v(r, 2)) = Dic(buf)(v(r, 2)) & " " & v(r, 3) End If Next End With Me.ListBox1.List = Dic.Keys End Sub Private Sub UserForm_Terminate() Dim i, dic2 As Dictionary For Each i In Dic.Items i.RemoveAll Next Dic.RemoveAll End Sub 解説 リストボックス1のデータは、Dic(Dictionaryオブジェクト）のKeyに格納します。 さらにDicのItem毎にDictionaryオブジェクトを生成して、 そのKeyにリストボックス2のデータを格納し、 Itemにはリストボックス3のデータを空白区切りの文字列として格納します。 リストボックスのリストにセットするのは、 リストボックス1は、Dic.Keys で配列として取り出せるので、 Listプロパティに代入します。 リストボックス2は、Dic(Me.ListBox1.Value).Keys で配列として取り出して、 Listプロパティに代入します。 リストボックス2は、Dic(Me.ListBox1.Value)(Me.ListBox2.Value) で 空白区切りの文字列として取り出せるので、Split で配列に変換して、 Listプロパティに代入します。 （hatena） 2018/06/11(月) 13:55... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201806/20180609095822.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97040 documents and 608209 words.
訪問者：