Results of 1 - 1 of about 37672 for IF (0.008 sec.)
- [[20210816145809]]
- #score: 1591
- @digest: 63c71bee58eccc763be1645224153b60
- @id: 88676
- @mdate: 2021-09-08T02:57:44Z
- @size: 59998
- @type: text/plain
- #keywords: 択行 (190991), listbox3 (166629), ミネ (143587), dlastrow (142097), listbox2 (120925), 肉4 (92351), 行b (89260), スー (75731), listbox1 (73725), fmliststyleoption (67951), liststyle (67016), listcount (62529), 行a (60988), selected (59305), 玉ね (56623), 牛肉 (54543), boundcolumn (53578), fmmultiselectmulti (53277), タ") (43610), rrr (40620), ジン (38869), プカ (37498), カレ (34772), プミ (32527), columnwidths (31742), ーネ (29789), ネス (29081), list (28235), multiselect (25543), columncount (23061), iii (21977), レー (20184)
- 『VBA リストボックス追加』（Aya）
VBA初心者です。教えてください。 既存のVBAにリストボックスを追加したいと思っています。 ?@List Box1の前にList Box3を追加 [List Box3の元データはデータシートのC列2行目以降を参照し、重複するものは表示しない] ?AList Box2の列の最後にデータシートF列2行目以降のデータも表示させる [現在D,E列のデータが表示されているのでF列も追加したい] 以上2点を追記したいです。 不慣れで質問も不十分でしたらすみませんが、詳しい方おられましたら、よろしくお願いいたします。 ---------------------------------------------------------------- Option Explicit Dim 選択行A As Long '選択行カウンタ Dim 選択行B As Long '選択行カウンタ Dim 格納行A As Long Dim 格納行B As Long Private Sub CommandButton1_Click() Dim iii As Integer Dim rrr As Integer Dim iiii As Integer Dim rrrr As Integer Range(Cells(6, 10), Cells(23, 10)) = "" Range(Cells(9, 2), Cells(21, 2)) = "" Range(Cells(6, 11), Cells(23, 11)) = "" With ListBox2 If .ListIndex = -1 Then '何も選択されていなければ MsgBox "何も選ばれていません" Exit Sub End If iiii = 6 rrrr = 0 For 選択行B = 0 To .ListCount - 1 If .Selected(選択行B) Then '選択されている行ならば ActiveSheet.Cells(iiii, 10) = .List(選択行B, 0) ActiveSheet.Cells(iiii, 11) = .List(選択行B, 1) If ActiveSheet.Cells(iiii, 2) = "" Then End If iiii = iiii + 1 Unload Me End If Next End With End Sub Private Sub Label11_Click() End Sub Private Sub Label2_Click() End Sub Private Sub ListBox1_Change() Dim ii As Integer Dim rr As Integer Dim DLastRow As Integer DLastRow = Worksheets("データ").Range("D" & Rows.Count).End(xlUp).Row rr = 0 ListBox2.Clear With ListBox1 For 選択行A = 0 To .ListCount - 1 If .Selected(選択行A) Then '選択されている行ならば For ii = 2 To DLastRow If .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then ListBox2.AddItem Worksheets("データ").Cells(ii, 4).Value ListBox2.List(rr, 1) = Worksheets("データ").Cells(ii, 5).Value rr = rr + 1 End If Next With ListBox2 .ColumnCount = 2 .BoundColumn = 0 .ColumnWidths = "100;300" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With End If Next Dim rrr As Integer Dim iii As Integer For rrr = 0 To ListBox2.ListCount - 1 iii = 8 Do Until Cells(iii, 10) = "" If iii >= 22 Then Exit Sub End If If ListBox2.List(rrr, 1) = Cells(iii, 11).Value Then ListBox2.Selected(rrr) = True End If iii = iii + 1 Loop Next rrr End With End Sub Private Sub ListBox2_Change() Dim i As Integer Dim rrrrr As Integer Dim iiiii As Integer Dim JLastRow As Integer JLastRow = Range("J23").End(xlUp).Row iiiii = 0 For rrrrr = 0 To ListBox2.ListCount - 1 If ListBox2.Selected(rrrrr) = True Then iiiii = iiiii + 1 End If Next rrrrr Txt件数 = 18 - iiiii If Txt件数 < 0 Then MsgBox "これ以上登録できません。" End If End Sub Private Sub ListBox3_Click() End Sub Private Sub Txt件数_Change() End Sub Private Sub UserForm_Initialize() Dim i As Integer Dim r As Integer Dim BLastRow As Integer ListBox1.Clear With Worksheets("データ") BLastRow = .Range("B" & Rows.Count).End(xlUp).Row r = 0 For i = 2 To BLastRow ListBox1.AddItem .Cells(i, 2).Value r = r + 1 Next With ListBox1 .ColumnCount = 1 .BoundColumn = 0 .ColumnWidths = "125" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With Dim rr As Integer Dim ii As Integer For rr = 0 To ListBox1.ListCount - 1 ii = 8 Do Until Cells(ii, 10) = "" If ListBox1.List(rr, 0) = Cells(ii, 10).Value Then ListBox1.Selected(rr) = True End If ii = ii + 1 Loop Next rr Dim rrr As Integer Dim iii As Integer For rrr = 0 To ListBox2.ListCount - 1 iii = 6 Do Until Cells(iii, 10) = "" If ListBox2.List(rrr, 1) = Cells(iii, 11).Value Then ListBox2.Selected(rrr) = True End If iii = iii + 1 Loop Next rrr End With End Sub ----------------------------------------------------------------------- ＜ 使用 Excel:unknown、使用 OS:unknown ＞ ---- ＞List Box1の前にList Box3を追加 何をしたいのかわかりません。 ＞List Box2の列の最後にデータシートF列2行目以降のデータも表示させる （「列の最後に」の意味がよくわかりませんが、推測で） 追加 ListBox2.List(rr, 1) = Worksheets("データ").Cells(ii, "F").Value 修正（3列にして、3列目の幅を指定） .ColumnCount = 3 .ColumnWidths = "100;300;300" （てきとう） 2021/08/16(月) 16:48 ---- 質問の仕方が悪いにもかかわらずお答えいただきありがとうございました。 推測で教えて頂いたコードを参照し、List Box2の部分は思っていた通りにできました! ＞List Box1の前にList Box3を追加 現在、データシートを基に… List Box1でリスト（データシートD列）から選択して、 List Box2で絞り込んだリストが（データシートD,E列）表示される。 となっているものを… List Box3:リスト（データシートC列）から選択して、 List Box1:List Box3で絞り込まれたリスト（データシートD列）から選択して、 List Box2:List Box1で絞り込まれたリスト（データシートD,E、F列）が表示される。 と、したいです。 言語化が下手ですみません。 引き続きよろしくお願いいたします。 （Aya） 2021/08/17(火) 11:39 ---- まだわかりませんが、ListBox3の初期化部分だけ。 Private Sub UserForm_Initialize() Dim i As Integer Dim r As Integer Dim BLastRow As Integer '・・ 追加分 ・・ With Worksheets("データ") 'ListBox3 With ListBox3 .Clear .ColumnCount = 1 .BoundColumn = 0 .ColumnWidths = "125" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With r = 0 For i = 2 To .Range("C" & Rows.Count).End(xlUp).Row If WorksheetFunction.CountIf(.Range("C2:C" & i), .Cells(i, "C")) <= 1 Then ListBox3.AddItem .Cells(i, "C").Value r = r + 1 End If Next End With ListBox1.Clear '・・ 追加分 ここまで ・・ 以下略 イメージとしては、C列が大項目、D列が中項目・・・みたいなものかと思うのですが、 サンプルデータを示していただけるとわかりやすいかも。 （きまぐれ） 2021/08/17(火) 13:01 ---- コメントありがとうございます。 教えて頂いたコードで、だいぶ完成形に近づきました! サンプルデータ作ってみました… C D E F 1 カテゴリー メニュー 材料 NO. ----------------------------------------------- 2 おかず 肉じゃが ニンジン 1 3 おかず 肉じゃが じゃがいも 2 4 おかず 肉じゃが 玉ねぎ 3 5 おかず 肉じゃが 牛肉 4 6 おかず 肉じゃが インゲン 5 7 おかず カレー ニンジン 1 8 おかず カレー じゃがいも 2 9 おかず カレー 玉ねぎ 3 10 おかず カレー 牛肉 4 11 おかず ギョウザ 豚挽肉 5 12 おかず ギョウザ キャベツ 6 13 おかず ギョウザ ニラ 7 14 スープ オニオンスープ 玉ねぎ 3 15 スープ オニオンスープ ベーコン 8 16 スープ ミネストローネ 玉ねぎ 3 17 スープ ミネストローネ ニンジン 1 18 スープ ミネストローネ じゃがいも 2 19 スープ ミネストローネ ベーコン 8 20 スープ ミネストローネ トマト 9 21 スープ ミネストローネ キャベツ 6 良い例が思いつかず、すみません。笑 こんな感じで5000件程のデータがあり、 1.List Box3:"カテゴリー"を選択 ↓ 2.List Box1:1.で絞られた"メニュー"のみが表示される ↓ 3.List Box2:2.で絞られた"材料"を選択する （List Box2には メニュー 材料 No. が表示されている） あー、何度書き直してもわかりにくい説明ですみません。 カテゴリーとメニューでは重複を表示させたくないのですが、List Box2では、 サンプルデータにあるように、例えば”ニンジン”でも、 肉じゃがのニンジン、カレーのニンジン、ミネストローネのニンジン…と該当すれば重複していても表示させたいのです。 引き続きお願いいたします。 （Aya） 2021/08/17(火) 15:57 ---- ListBox1で絞られた材料をListBox2で選択するんですよね? では、スープ→ミネストローネと来たら、 ListBox2には、どのような値が入って欲しいんですか? （tkit） 2021/08/17(火) 16:32 ---- コメントありがとうございます。 >では、スープ→ミネストローネと来たら、 List Box2には・・・ ミネストローネ 玉ねぎ 3 ミネストローネ ニンジン 1 ミネストローネ じゃがいも 2 ミネストローネ ベーコン 8 ミネストローネ トマト 9 ミネストローネ キャベツ 6 が入ってほしいです。 例えばスープ→オニオンスープとミネストローネを選択したら、 オニオンスープ 玉ねぎ 3 オニオンスープ ベーコン 8 ミネストローネ 玉ねぎ 3 ミネストローネ ニンジン 1 ミネストローネ じゃがいも 2 ミネストローネ ベーコン 8 ミネストローネ トマト 9 ミネストローネ キャベツ 6 が入ってほしいです。 （Aya） 2021/08/17(火) 16:52 ---- リストボックス3を選択したときに、リストボックス1を変更する部分です。 （ListBoxを使うことがあまりないので、効率悪いかもです。） Private Sub ListBox3_Change() 'ListBox1に、ListBox3で選択されているカテゴリーのメニューを追加 Dim c As Long Dim i As Long With ListBox1 .Clear .ColumnCount = 1 .BoundColumn = 0 .ColumnWidths = "125" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With With Worksheets("データ") For c = 0 To ListBox3.ListCount - 1 If ListBox3.Selected(c) Then MsgBox ListBox3.List(c) For i = 2 To .Range("D" & Rows.Count).End(xlUp).Row If .Cells(i, "C") = ListBox3.List(c) Then If WorksheetFunction.CountIf(.Range("D2:D" & i), .Cells(i, "D")) <= 1 Then ListBox1.AddItem .Cells(i, "D").Value End If End If Next End If Next End With End Sub （きまぐれ） 2021/08/18(水) 08:16 ---- ListBox1はMultSelectなんですか。 では、 1. ListBox1のSelectedをListIndex分For Nextで回し、選択している値を取得 2. ↑の値とlistを比較しListBox2にAddする '選択アイテム取得サンプル For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) Then Debug.Print ListBox1.List(i) Next 上記サンプルと現状のコードを組み合わせれば、ある程度形になるのでは （tkit） 2021/08/18(水) 08:45 ---- きまぐれ様 コメントありがとうございます。 教えて頂いたコードで、できてきました!ありがとうございます。 1.User Form1を開いたときにList Box1を（List Box3を選択して絞られるまでは）非表示に。 2.List Box2での重複は非表示に。 3.List Box3で選択してもList Box1に表示されない場合がある。 ↓ 下記サンプルの場合で、 おかずとスープに「カレー」があり、 おかず→カレーと選択するとうまくいくが、 おかずを選択せずにスープのみ選択した場合、「カレー」の選択肢が表示されない。 C D E F 1 カテゴリー メニュー 材料 NO. =================================================== 2 おかず 肉じゃが ニンジン 1 3 おかず 肉じゃが じゃがいも 2 4 おかず 肉じゃが 玉ねぎ 3 5 おかず 肉じゃが 牛肉 4 6 おかず 肉じゃが インゲン 5 7 おかず カレー ニンジン 1 8 おかず カレー じゃがいも 2 9 おかず カレー 玉ねぎ 3 10 おかず カレー 牛肉 4 11 おかず ギョウザ 豚挽肉 5 12 おかず ギョウザ キャベツ 6 13 おかず ギョウザ ニラ 7 14 スープ オニオンスープ 玉ねぎ 3 15 スープ オニオンスープ ベーコン 8 16 スープ ミネストローネ 玉ねぎ 3 17 スープ ミネストローネ ニンジン 1 18 スープ ミネストローネ じゃがいも 2 19 スープ ミネストローネ ベーコン 8 20 スープ ミネストローネ トマト 9 21 スープ ミネストローネ キャベツ 6 22 スープ カレー ニンジン 1 23 スープ カレー じゃがいも 2 24 スープ カレー 玉ねぎ 3 25 スープ カレー 牛肉 4 次々とすみませんが、引き続きお願いいたします。 （Aya） 2021/08/18(水) 11:27 ---- tkit様 コメントありがとうございます。 はい、List Box1〜3は複数選択ができるようにしたいです。 でもすみません。 VBAの知識がなさ過ぎて、tkit様が教えてくださったことを理解できるスペックもなく、 コードをどこに組み合わせればいいかもわかりません… せっかく教えて頂いたのに、すみません… どこにコードを組み合わせればいいかまで教えて頂けますでしょうか… ほんとにすみません。 （Aya） 2021/08/18(水) 11:50 ---- えっと、 Excelのバージョンを教えてください。 (COUNTIFS 関数が使えるか) （きまぐれ） 2021/08/18(水) 12:58 ---- 作成依頼なんですね。 興味がある内容でもないので、撤退します。 どなたか親切な方がコード提供してくれるかもしれませんね。 （tkit） 2021/08/18(水) 13:00 ---- きまぐれ様 Excelのバージョンは2016です。 ありがとうございます。 （Aya） 2021/08/18(水) 13:42 ---- tkit様 厚かましいお願いで申し訳ありませんでした。 でもわざわざコメントしてくださり、ありがとうございました。 もっとVBA勉強していきます。 （Aya） 2021/08/18(水) 13:45 ---- ＞おかずを選択せずにスープのみ選択した場合、「カレー」の選択肢が表示されない。 ＞Excelのバージョンは2016です。 では、こちらに入れ替えてください。 Private Sub ListBox3_Change() 'ListBox1に、ListBox3で選択されているカテゴリーのメニューを追加 Dim c As Long Dim i As Long With ListBox1 .Clear .ColumnCount = 1 .BoundColumn = 0 .ColumnWidths = "125" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption .Visible = True End With With Worksheets("データ") For c = 0 To ListBox3.ListCount - 1 If ListBox3.Selected(c) Then MsgBox ListBox3.List(c) For i = 2 To .Range("D" & Rows.Count).End(xlUp).Row If .Cells(i, "C") = ListBox3.List(c) Then If WorksheetFunction.CountIfs(.Range("C2:C" & i), .Cells(i, "C"), .Range("D2:D" & i), .Cells(i, "D")) <= 1 Then ListBox1.AddItem .Cells(i, "D").Value End If End If Next End If Next End With End Sub ＞User Form1を開いたときにList Box1を（List Box3を選択して絞られるまでは）非表示に。 Private Sub UserForm_Initialize() ・・ 中略 ・・ ListBox1.Visible = False '←どこでも大丈夫です ・・ 以下略 ・・ ほかも、これらの応用でできると思います。 （きまぐれ） 2021/08/18(水) 15:20 ---- きまぐれ様 ありがとうございます! これでできそうです!! これでList Box1も応用してみます!! ＞User Form1を開いたときにList Box1を（List Box3を選択して絞られるまでは）非表示に。 言葉選びが下手ですみません。 List Box自体を非表示ではなく、List Box1内の文字を表示させないでおきたいです。。。 （Aya） 2021/08/18(水) 16:35 ---- ＞＞User Form1を開いたときにList Box1を（List Box3を選択して絞られるまでは）非表示に。 ＞言葉選びが下手ですみません。 ＞List Box自体を非表示ではなく、List Box1内の文字を表示させないでおきたいです。。。 そういうことなら・・・ ・UserForm1を開いたときに、ListBox1内の文字を表示させているのは、 元からあるコードなので、ご自分で対応してください。 ・とりあえず下記のようにすれば、ご希望の動作になると思います。 （不要なコードが残り、無駄な動作をしますが・・・） Private Sub UserForm_Initialize() '・・ 中略 ・・ ListBox1.Clear End Sub （きまぐれ） 2021/08/19(木) 08:10 ---- きまぐれ 様 コメントありがとうございます。 教えて頂いたコードの応用が上手くいかず、悪戦苦闘していたことと、 公私ともにバタバタしており、お返事が遅くなってしまい、大変失礼いたしました。 ＞List Box自体を非表示ではなく、List Box1内の文字を表示させないでおきたいです。。。 に関して、教えて頂いた通りで、ばっちり解決出来ました。 ありがとうございました! （Aya） 2021/08/23(月) 13:49 ---- ＞ほかも、これらの応用でできると思います。 先日教えて頂いたコードを自分なりに応用してみたのですが（下記）、どうしてもうまくいきませんでした。 応用の仕方が間違っているのですよね… 何から何まで頼りっぱなしで申し訳ございませんが、 引き続き教えて下さい。。。 Private Sub ListBox1_Change() 'ListBox2に、ListBox1で選択されているカテゴリーのメニューを追加 Dim c As Long Dim i As Long With ListBox2 .Clear .ColumnCount = 1 .BoundColumn = 0 .ColumnWidths = "125" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption .Visible = True End With With Worksheets("データ") For c = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(c) Then MsgBox ListBox1.List(c) For i = 2 To .Range("E" & Rows.Count).End(xlUp).Row If .Cells(i, "D") = ListBox1.List(c) Then If WorksheetFunction.CountIfs(.Range("D2:D" & i), .Cells(i, "D"), .Range("E2:E" & i), .Cells(i, "E")) <= 1 Then ListBox2.AddItem .Cells(i, "E").Value End If End If Next End If Next End With End Sub （Aya） 2021/08/23(月) 14:23 ---- ＞どうしてもうまくいきませんでした。 どのように「うまくいかない」のか説明してください。 （きまぐれ） 2021/08/23(月) 14:38 ---- 説明不足ですみません。 下記サンプルデータで言うと… おかず→カレーを選択すると、 カレー ニンジン 1 カレー ニンジン 1 カレー じゃがいも 2 カレー じゃがいも 2 カレー 玉ねぎ 3 カレー 玉ねぎ 3 カレー 牛肉 4 カレー 牛肉 4 と言うように「おかず」のカレーだけではなく、「スープ」のカレーの分まで出てきてしまいます。 C D E F 1 カテゴリー メニュー 材料 NO. =================================================== 2 おかず 肉じゃが ニンジン 1 3 おかず 肉じゃが じゃがいも 2 4 おかず 肉じゃが 玉ねぎ 3 5 おかず 肉じゃが 牛肉 4 6 おかず 肉じゃが インゲン 5 7 おかず カレー ニンジン 1 8 おかず カレー じゃがいも 2 9 おかず カレー 玉ねぎ 3 10 おかず カレー 牛肉 4 11 おかず ギョウザ 豚挽肉 5 12 おかず ギョウザ キャベツ 6 13 おかず ギョウザ ニラ 7 14 スープ オニオンスープ 玉ねぎ 3 15 スープ オニオンスープ ベーコン 8 16 スープ ミネストローネ 玉ねぎ 3 17 スープ ミネストローネ ニンジン 1 18 スープ ミネストローネ じゃがいも 2 19 スープ ミネストローネ ベーコン 8 20 スープ ミネストローネ トマト 9 21 スープ ミネストローネ キャベツ 6 22 スープ カレー ニンジン 1 23 スープ カレー じゃがいも 2 24 スープ カレー 玉ねぎ 3 25 スープ カレー 牛肉 4 （Aya） 2021/08/23(月) 16:06 ---- また、 おかずとスープを選択したときにカレーが2行となってList Box1に表示されるのも、 1行だけ表示されるようにしたいです。 （Aya） 2021/08/23(月) 16:16 ---- ＞「おかず」のカレーだけではなく、「スープ」のカレーの分まで出てきてしまいます 出てこないですね。 ↓のコードではじかれるはずです。 If WorksheetFunction.CountIfs(.Range("D2:D" & i), .Cells(i, "D"), .Range("E2:E" & i), .Cells(i, "E")) <= 1 Then ＞おかずとスープを選択したときにカレーが2行となって..1行だけ表示されるように 同じ項目があれば、削除するコードを追加します。 （同じ項目を追加しないというアプローチもあるかと思いますが.. Dictionaryオブジェクトとか） Private Sub ListBox3_Change() 'ListBox1に、ListBox3で選択されているカテゴリーのメニューを追加 '・・ 中略 ・・ For c = ListBox1.ListCount - 1 To 1 Step -1 For i = c - 1 To 0 Step -1 If ListBox1.List(c) = ListBox1.List(i) Then ListBox1.RemoveItem c Exit For End If Next Next End Sub （きまぐれ） 2021/08/23(月) 16:53 ---- きまぐれ 様 ありがとうございます。 ＞同じ項目があれば、削除するコードを追加します。 これでList Box3と1はうまくいきました!ありがとうございます。 あと1点…＞＜ 下記サンプルで、牛肉・豚肉とある場合、 おかず→カレーを選ぶと ニンジン じゃがいも 玉ねぎ 牛肉 豚肉 が表示されてしまいます。 重複はされないようになったのですが、絞り込みが上手くいくいません。 何度もすみません。よろしくお願いします。 C D E F 1 カテゴリー メニュー 材料 NO. =================================================== 2 おかず カレー ニンジン 1 3 おかず カレー じゃがいも 2 4 おかず カレー 玉ねぎ 3 5 おかず カレー 牛肉 4 6 スープ カレー ニンジン 1 7 スープ カレー じゃがいも 2 8 スープ カレー 玉ねぎ 3 9 スープ カレー 豚肉 4 Private Sub ListBox1_Change() Dim ii As Integer Dim rr As Integer Dim DLastRow As Integer Dim i As Long DLastRow = Worksheets("データ").Range("D" & Rows.Count).End(xlUp).Row rr = 0 ListBox2.Clear With ListBox1 For 選択行A = 0 To .ListCount - 1 If .Selected(選択行A) Then '選択されている行ならば For ii = 2 To DLastRow If .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then ListBox2.AddItem Worksheets("データ").Cells(ii, 4).Value ListBox2.List(rr, 1) = Worksheets("データ").Cells(ii, 5).Value ListBox2.List(rr, 2) = Worksheets("データ").Cells(ii, 6).Value rr = rr + 1 End If Next With ListBox2 .ColumnCount = 3 .BoundColumn = 0 .ColumnWidths = "100;350;50" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With End If Next Dim rrr As Integer Dim iii As Integer For rrr = 0 To ListBox2.ListCount - 1 iii = 8 Do Until Cells(iii, 10) = "" If iii >= 22 Then Exit Sub End If If ListBox2.List(rrr, 1) = Cells(iii, 11).Value Then ListBox2.Selected(rrr) = True End If iii = iii + 1 Loop Next rrr End With End Sub （Aya） 2021/08/24(火) 11:27 ---- ＞下記サンプルで、牛肉・豚肉とある場合、 ＞おかず→カレーを選ぶと ＞ニンジン ＞じゃがいも ＞玉ねぎ ＞牛肉 ＞豚肉 こちらでは、こうなりますが... ニンジン じゃがいも 玉ねぎ 牛肉 ニンジン じゃがいも 玉ねぎ 豚肉 まあ、それはいいとして... 現状のコードでは、ListBox1で選択されている項目（メニュー）に該当するものを 全てListBox2に追加しているため、そうなります。 対策としては、 ListBox3で選択されている項目（カテゴリー） かつ ListBox1で選択されている項目（メニュー） に該当するものをListBox2に追加すればいいです。 具体的には、ListBox1のループの外側にListBox3のループをつくり、 ＞If .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then を修正するとよいでしょう。 まずは、ご自分で挑戦してみてください。 （きまぐれ） 2021/08/24(火) 14:27 ---- きまぐれ 様 コメントありがとうございます。 知識がなさすぎて頼りっぱなしになってしまい申し訳ございません。 ご丁寧に対策まで教えて頂きありがとうございます。 「ループ」から勉強し、引き続き挑戦してみます。 （Aya） 2021/08/24(火) 15:04 ---- 余談です。 Private Sub ListBox1_Change()の中にある下記のコードは、 ループの中にある必要はありません。 ListBox2.Clearのうしろへ移動しましょう。 With ListBox2 .ColumnCount = 3 '中略 End With さらに言えば、Private Sub UserForm_Initialize()へ移動して、1回だけ実行されればよいです。 ※意味不明ならスルーしてください。 （きまぐれ） 2021/08/25(水) 08:46 ---- きまぐれ 様 ありがとうございます。 ＞ループの中にある必要はありません。 動作に無駄があるという事ですよね。 こちらな理解でき、コードも上手く修正できた!…と思います＞＜ ＞If .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then ここの修正がまだ理解できておらず、完成はしていないのですが、 「きまぐれ」と言うニックネームとのギャップがすごく、 とても親切にしていただきありがとうございます。 さらにコードの改善箇所まで教えてくださるとは思っておらず、感激しました!! （Aya） 2021/08/25(水) 16:00 ---- えっと、きまぐれに回答しているのでいつ投げ出すかわかりませんよ。 さて、 ＞If .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then は、ListBox1の選択されているデータ（例:カレー）と シート上の表のD列（メニュー）と一致するかを見ています。 ここに、ListBox3の選択されているデータ（例:スープ）と シート上の表のC列（カテゴリー）も一致するかを見るようにすればよいです。 イメージとしては、こんな感じです。 If （ListBox3のカテゴリーがC列と一致） And （ListBox1のメニューがD列と一致） Then （きまぐれ） 2021/08/25(水) 16:28 ---- きまぐれ 様 さらなるヒントをありがとうございます。 いつ投げ出されてしまっても仕方ない程のレベルなのは重々承知しております＞＜ 教えて頂いたことを自分なりに考え、コード変更しましたが、 List Box2の選択肢が表示されない状態です。 トンチンカンなコード変更をしていますでしょうか?＞＜ Private Sub ListBox1_Change() Dim ii As Integer Dim rr As Integer Dim DLastRow As Integer Dim i As Long Dim c As Long DLastRow = Worksheets("データ").Range("D" & Rows.Count).End(xlUp).Row rr = 0 ListBox2.Clear With ListBox1 For 選択行A = 0 To .ListCount - 1 If .Selected(選択行A) Then '選択されている行ならば For ii = 2 To DLastRow If .List(選択行B, 0) = Worksheets("データ").Cells(ii, 5) And _ .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then ListBox2.AddItem Worksheets("データ").Cells(ii, 4).Value ListBox2.List(rr, 1) = Worksheets("データ").Cells(ii, 5).Value ListBox2.List(rr, 2) = Worksheets("データ").Cells(ii, 6).Value rr = rr + 1 End If Next End If Next Dim rrr As Integer Dim iii As Integer For rrr = 0 To ListBox3.ListCount - 1 iii = 8 Do Until Cells(iii, 10) = "" If iii >= 22 Then Exit Sub End If If ListBox3.List(rrr, 1) = Cells(iii, 11).Value Then ListBox3.Selected(rrr) = True End If iii = iii + 1 Loop Next For rrr = 0 To ListBox1.ListCount - 1 iii = 8 Do Until Cells(iii, 10) = "" If iii >= 22 Then Exit Sub End If If ListBox1.List(rrr, 1) = Cells(iii, 11).Value Then ListBox1.Selected(rrr) = True End If iii = iii + 1 Loop Next rrr End With End Sub （Aya） 2021/08/25(水) 17:46 ---- ＞If .List(選択行B, 0) = Worksheets("データ").Cells(ii, 5) And _ ＞ .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then これだと、 1)ListBox1の最初のデータ（肉じゃが）とシート上のE列（ニンジンとか）が一致 かつ 2)ListBox1の選択行A番目のデータとシート上のD列が一致したとき という意味になります。 1)の条件が満たされることがないので、ListBox2に追加されません。 また、変数「選択行B」に代入されていないのも原因の一つです。 （きまぐれ） 2021/08/25(水) 18:46 ---- ＞ListBox1のループの外側にListBox3のループをつくり、 ↓こんな感じです。 Private Sub ListBox1_Change() '・・ 中略 ・・ With ListBox1 'ここに、ListBox3のリストでループを追加 (例:For 選択行B = 0 To ListBox3.ListCount - 1) 'ListBox3の選択されている行ならば For 選択行A = 0 To .ListCount - 1 '** ListBox1のリストでループ If .Selected(選択行A) Then 'ListBox1の選択されている行ならば '・・ 中略 ・・ End If Next 'ListBox3のリストでループここまで '・・ 中略 ・・ End With End Sub （きまぐれ） 2021/08/26(木) 08:26 ---- きまぐれ 様 コメントありがとうございます。 丁寧に教えて頂いているのに、わからずごめんなさい… 教えて頂いた様に修正したつもりなのですが、 「381 list プロパティを設定できません。 プロパティの配列のインデックスが無効です。」 とエラーがでてしまいます。 エラーについて調べてみたのですが、理解できず、何度もすみませんが、 引き続き教えて頂けませんでしょうか… Private Sub ListBox1_Change() Dim ii As Integer Dim rr As Integer Dim DLastRow As Integer Dim i As Long Dim c As Long DLastRow = Worksheets("データ").Range("D" & Rows.Count).End(xlUp).Row rr = 0 ListBox2.Clear With ListBox1 For 選択行B = 0 To ListBox3.ListCount - 1 'ListBox3の選択されている行ならば For 選択行A = 0 To ListBox1.ListCount - 1 If .Selected(選択行A) Then 'ListBox1の選択されている行ならば For ii = 2 To DLastRow If .List(選択行B, 0) = Worksheets("データ").Cells(ii, 3) And _ .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then ListBox2.List(rr, 1) = Worksheets("データ").Cells(ii, 5).Value ListBox2.List(rr, 2) = Worksheets("データ").Cells(ii, 6).Value rr = rr + 1 End If Next End If Next Next Dim rrr As Integer Dim iii As Integer For rrr = 0 To ListBox1.ListCount - 1 iii = 8 Do Until Cells(iii, 10) = "" If iii >= 22 Then Exit Sub End If If ListBox1.List(rrr, 1) = Cells(iii, 11).Value Then ListBox1.Selected(rrr) = True End If iii = iii + 1 Loop Next rrr End With End Sub （Aya） 2021/08/26(木) 14:46 ---- ＞「381 list プロパティを設定できません。 プロパティの配列のインデックスが無効です。」 ＞ If .List(選択行B, 0) = Worksheets("データ").Cells(ii, 3) And _ 変数「選択行B」が、ListBox1のリスト数を超えたためでしょう。 ここは、ListBox3の「List(選択行B, 0)」を使う必要があります。 ※これを直すと、もう一つエラーがでますね。 あと、「'ListBox3の選択されている行ならば」として、 「 If .Selected(選択行A) Then 」のListBox3用を書く必要があります。 とりあえず動くので、後で対応して下さい。 （「カレー」が余計に出てきます） 余談ですが、デバッグの方法を習得するといいと思います。 「ステップ実行」「ブレークポイント」「イミディエイトウィンドウ」などのキーワードで 検索してみて下さい。 （きまぐれ） 2021/08/26(木) 15:25 ---- きまぐれ 様 コメントありがとうございます。 ＞変数「選択行B」が、ListBox1のリスト数を超えたためでしょう。 んー。。。 アドバイスまでありがとうございます。 アドバイス頂いたキーワードと合わせて、 検索してみます＞＜ （Aya） 2021/08/26(木) 16:39 ---- あれ、エラーがでたのはここじゃない? ＞ If .List(選択行B, 0) = Worksheets("データ").Cells(ii, 3) And _ もしそうなら、エラーがでた行を教えて下さい。 （エラーがでたときに、「デバッグ」を押すと、黄色で表示されます） （きまぐれ） 2021/08/26(木) 17:00 ---- すみません。 「381 list プロパティを設定できません。 プロパティの配列のインデックスが無効です。」 で黄色で表示される箇所は If .List(選択行B, 0) = Worksheets("データ").Cells(ii, 3) And _ .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then です。 ＞ 変数「選択行B」が、ListBox1のリスト数を超えたためでしょう。 ＞ ここは、ListBox3の「List(選択行B, 0)」を使う必要があります。 ここの理解ができるかな…と不安しかなかった気持ちのままコメントしてしまい、すみません。。。 （Aya） 2021/08/27(金) 09:31 ---- 了解です。補足しておきます。 「.List(選択行A, 0)」は、その前にある「With ListBox1」の効果で 「ListBox1.List(選択行A, 0)」と解釈されます。 「.List(選択行B, 0)」も同様に、「ListBox1.List(選択行B, 0)」と解釈されます。 一方で、「選択行B」は、「For 選択行B = 0 To ListBox3.ListCount - 1」によって 「0〜ListBox3.ListCount - 1」の範囲で変化します。 データやListBox3で選択した項目にもよりますが、 ListBox3の項目数ListBox1の項目数より多いとき、 変数「選択行B」が、ListBox1の項目数を超えてエラーになります。 ※余計にわかりにくいか... （きまぐれ） 2021/08/27(金) 12:28 ---- きまぐれ 様 詳しくご説明いただきありがとうございます。 If ListBox3.List(選択行B, 0) = Worksheets("データ").Cells(ii, 3) And _ .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then こういう事でしょうか…? これで黄色のエラーは消えマクロの実行が可能になりました! …が、ListBox2の内容が重複して表示されてしまします。 次は先日教えて頂いた ＞あと、「'ListBox3の選択されている行ならば」として、 ＞｛ If .Selected(選択行A) Then 」のListBox3用を書く必要があります。 ＞とりあえず動くので、後で対応して下さい。 …を修正すればいいんでしょうか?＞＜ （Aya） 2021/08/27(金) 14:17 ---- > こういう事でしょうか…? 正解です。 >…を修正すればいいんでしょうか? そうです。 ※外出しててスマホからなので、簡単なコメントになってます。 （きまぐれ） 2021/08/27(金) 14:35 ---- 外出中にありがとうございます! ＞正解です。 良かった!嬉しい! ＞そうです。 ありがとうございます。 では、ここをがんばってみます!! （Aya） 2021/08/27(金) 14:51 ---- きまぐれ様 おはようございます。 教えて頂いたコード、実行できました! With ListBox1 For 選択行B = 0 To ListBox3.ListCount - 1 'ListBox3の選択されている行ならば For 選択行A = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(選択行A) Then 'ListBox1の選択されている行ならば If ListBox3.Selected(選択行B) Then 'ListBox3の選択されている行ならば For ii = 2 To DLastRow If ListBox3.List(選択行B, 0) = Worksheets("データ").Cells(ii, 3) And _ .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then 本当にありがとうございました!! ただただコードを教えるだけではなく、考え方やヒント、勉強すべきことなどまで教えて頂き、 本当にありがとうございます。 （Aya） 2021/08/30(月) 11:25 ---- できたみたいでよかったですね。 せっかくなので、全コードをのせておいたらいかがでしょうか。 （今後、この掲示板を見る人の参考として） さて、今回提示されたコードについて、コメントです。 （結果に影響しないので、スルーしても構いません） ＞If ListBox3.Selected(選択行B) Then 'ListBox3の選択されている行ならば 結果は変わりませんが、↓の間へ移動すると、余計な動作が減ります。 For 選択行B = 0 To ListBox3.ListCount - 1 'ListBox3の選択されている行ならば 'ここへ移動 For 選択行A = 0 To ListBox1.ListCount - 1 （「End If」も適切な場所へ移動しないとエラーになります） （きまぐれ） 2021/08/30(月) 11:39 ---- きまぐれ様 より良いコードのご提案、ありがとうございます。 やってみます。 また、完成したら全コードをのせておきます。 アドバイスありがとうございました。 ・・・完成したと思ったのですが、また1点問題を発見してしまいました… すみません… おかずとスープを選択 → カレーを選択 → した場合、ListBox1の結果が重複してしまいます。 何度もすみません。引き続きお願いできますでしょうか。 （Aya） 2021/08/30(月) 13:36 ---- ＞おかずとスープを選択 → カレーを選択 → ＞した場合、ListBox1の結果が重複してしまいます。 ListBox2の結果が重複するということでしょうか? （おかずのカレーの材料 と スープのカレーの材料 がダブって出てくる） こちらではこうなりますが、どうしたいですか? ニンジン じゃがいも 玉ねぎ 牛肉 ニンジン じゃがいも 玉ねぎ 豚肉 1.単純に重複している項目を削除する。 ⇒ 下段の「ニンジン」・・「玉ねぎ」が消えて「豚肉」が残る 2.別のカテゴリーで、同名のメニューが選択されているときは表示しない ⇒ スープのカレーの材料は「豚肉」ですが、無視されます どちらにしましょうか? （きまぐれ） 2021/08/30(月) 16:17 ---- 補足 1.の場合、スープ オニオンスープ の玉ねぎ も消えます。 （きまぐれ） 2021/08/30(月) 16:31 ---- きまぐれ 様 お返事ありがとうございます。 下記サンプルデータの場合、 C D E F 1 カテゴリー メニュー 材料 NO. =================================================== 2 おかず 肉じゃが ニンジン 1 3 おかず 肉じゃが じゃがいも 2 4 おかず 肉じゃが 玉ねぎ 3 5 おかず 肉じゃが 牛肉 4 6 おかず 肉じゃが インゲン 5 7 おかず カレー ニンジン 1 8 おかず カレー じゃがいも 2 9 おかず カレー 玉ねぎ 3 10 おかず カレー 牛肉 4 11 おかず ギョウザ 豚挽肉 5 12 おかず ギョウザ キャベツ 6 13 おかず ギョウザ ニラ 7 14 スープ オニオンスープ 玉ねぎ 3 15 スープ オニオンスープ ベーコン 8 16 スープ ミネストローネ 玉ねぎ 3 17 スープ ミネストローネ ニンジン 1 18 スープ ミネストローネ じゃがいも 2 19 スープ ミネストローネ ベーコン 8 20 スープ ミネストローネ トマト 9 21 スープ ミネストローネ キャベツ 6 22 スープ カレー ニンジン 1 23 スープ カレー じゃがいも 2 24 スープ カレー 玉ねぎ 3 25 スープ カレー 豚肉 10 おかずとスープを選択 → カレーを選択 した場合、ListBox2には カレー ニンジン 1 カレー じゃがいも 2 カレー 玉ねぎ 3 カレー 牛肉 4 カレー 豚肉 10 と表示させたいです。 おかずとスープを選択 → カレーとオニオンスープを選択 した場合、ListBox2には カレー ニンジン 1 カレー じゃがいも 2 カレー 玉ねぎ 3 カレー 牛肉 4 カレー 豚肉 10 オニオンスープ 玉ねぎ 3 オニオンスープ ベーコン 8 と表示させたいです。 説明が下手で、ややこしくてすみません… （Aya） 2021/08/31(火) 09:45 ---- そうすると、以前ListBox1で重複しないようにしたコードが使えます。 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - For c = ListBox1.ListCount - 1 To 1 Step -1 For i = c - 1 To 0 Step -1 If ListBox1.List(c) = ListBox1.List(i) Then ListBox1.RemoveItem c Exit For End If Next Next - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 重複して登録されたListBox1に対して、 ・リストの下から処理 ・処理中の項目と一致する項目が、リストの上にあるか見ていく ・あれば、処理中の項目を削除 ということをしています。 これをListBox2に応用すればいいです。 具体的には、上記のコードを「Private Sub ListBox1_Change()」の適切な場所に記入し、 ListBox1 を ListBox2 に修正し、 重複の判定を、ListBox2の1列めが一致 かつ 2列めが一致 とすればいいです。 重複の判定式の修正がややこしいかと思いますが、未修正でも（希望と異なる結果になるが）動くので、 挑戦してみてください。 （きまぐれ） 2021/08/31(火) 10:20 ---- きまぐれ様 とっても丁寧にご説明いただき、ありがとうございます!! 教えて頂いたことを基に、挑戦してみます!! 完成した際には、全コードコメントさせてもらいたいと思います。 （Aya） 2021/09/01(水) 09:42 ---- 自分なりに調べたり、考えてコード修正してみたのですが、上手くいかず… ＞重複の判定式の修正がややこしいかと思いますが ヒントをいただけないでしょうか お願いします。 （Aya） 2021/09/06(月) 13:36 ---- とりあえず、現状の「Private Sub ListBox1_Change()」のコードを 提示して下さい。 （きまぐれ） 2021/09/06(月) 14:46 ---- きまぐれ様 いつもありがとうございます。 現状コードです。 以前教えて頂いた ＞結果は変わりませんが、↓の間へ移動すると、余計な動作が減ります。 の箇所も修正できず、 ListBoxの「1列目」の書き方さえもわからず、 無茶苦茶なコードですよね… すみません… Private Sub ListBox1_Change() Dim ii As Integer Dim rr As Integer Dim DLastRow As Integer Dim i As Long Dim c As Long DLastRow = Worksheets("データ").Range("D" & Rows.Count).End(xlUp).Row rr = 0 ListBox2.Clear With ListBox1 For 選択行B = 0 To ListBox3.ListCount - 1 'ListBox3の選択されている行ならば For 選択行A = 0 To ListBox1.ListCount - 1 If .Selected(選択行A) Then 'ListBox1の選択されている行ならば For ii = 2 To DLastRow If ListBox3.List(選択行B, 0) = Worksheets("データ").Cells(ii, 3) And _ .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then ListBox2.AddItem Worksheets("データ").Cells(ii, 4).Value ListBox2.List(rr, 1) = Worksheets("データ").Cells(ii, 5).Value ListBox2.List(rr, 2) = Worksheets("データ").Cells(ii, 6).Value rr = rr + 1 End If Next End If Next Next For c = ListBox2.ListCount - 1 To 1 Step -1 For i = c - 1 To 0 Step -1 If ListBox2.List(c, 0) = ListBox2.List(i, 0) And _ ListBox2.List(c, 1) = ListBox2.List(i, 1) Then ListBox2.RemoveItem c Exit For End If Next Next Dim rrr As Integer Dim iii As Integer For rrr = 0 To ListBox1.ListCount - 1 iii = 8 Do Until Cells(iii, 10) = "" If iii >= 22 Then Exit Sub End If If ListBox1.List(rrr, 1) = Cells(iii, 11).Value Then ListBox1.Selected(rrr) = True End If iii = iii + 1 Loop Next rrr End With End Sub （Aya） 2021/09/06(月) 16:36 ---- えっと、問題なさそうに見えますが、どのように「うまくいかない」のでしょうか? （きまぐれ） 2021/09/06(月) 16:48 ---- ごめんなさい。よく見てなかった。 これ↓ If ListBox3.Selected(選択行B) Then 'ListBox3の選択されている行ならば と End If が必要です。 For 選択行B = 0 To ListBox3.ListCount - 1 'ListBox3の選択されている行ならば ※ここ For 選択行A = 0 To ListBox1.ListCount - 1 If .Selected(選択行A) Then 'ListBox1の選択されている行ならば For ii = 2 To DLastRow If ListBox3.List(選択行B, 0) = Worksheets("データ").Cells(ii, 3) And _ .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then ListBox2.AddItem Worksheets("データ").Cells(ii, 4).Value ListBox2.List(rr, 1) = Worksheets("データ").Cells(ii, 5).Value ListBox2.List(rr, 2) = Worksheets("データ").Cells(ii, 6).Value rr = rr + 1 End If Next End If Next ※ここ Next （きまぐれ） 2021/09/06(月) 17:06 ---- ※余談です。いま発生している問題が解決するまでスルーして構いません。 1.コードのインデントは、きちんとつけましょう。間違いのもとになります。 2.変数の型 ＞Dim DLastRow As Integer 行番号を取得する変数なので、最大で1,048,576になります。 Integerだと32,767が最大値なので、オーバーフローになることがありますから ここはLongとしたほうがいいでしょう。 ※他にもあります 3.ListBoxに複数列を設定するとき ＞ListBox2.List(rr, 1) = Worksheets("データ").Cells(ii, 5).Value 変数rrを使っていますが、AddItemされたデータはリストの最後に追加されるので、 ListBox2.List(ListBox2.ListCount - 1, 1) = Worksheets("データ").Cells(ii, 5).Value と書くことができます（変数rrが不要になる） 言い忘れましたが「重複の判定式」は、あっています。 （希望通りの動作になったかはわかりませんが...） （きまぐれ） 2021/09/07(火) 08:19 ---- きまぐれ 様 ありがとうございます。 重複の判定式が間違っているとばかり思っていたのですが、 違うところが間違っていたのですね。 ありがとうございます!全て希望通りの動作になりました!! さらにコードの改良策も丁寧に教えて頂きありがとうございます。 コードのインデントにルールがあることさえも、 きまぐれ様にご指摘いただくまで知りませんでした。 （みんな配置のセンス良いな〜程度に思っていました。笑） 約1か月程に渡り、無知で説明も下手な私の質問を 見捨てることなく最後まで教えて下さり、本当にありがとうございました。 教えるだけでなく、説明も丁寧にして下さり、自分で考えられるようにヒントを出してくださったり… と本当に本当に感謝しています。 きまぐれ様に教えて頂いたこと全てを反映するまでにはまだ時間がかかりそうなので、 現状、不格好な箇所もあるかとは思いますが、全コードのせます。 Option Explicit Dim 選択行A As Long '選択行カウンタ Dim 選択行B As Long '選択行カウンタ Dim 格納行A As Long Dim 格納行B As Long Private Sub CommandButton1_Click() Dim iii As Long Dim rrr As Long Dim iiii As Long Dim rrrr As Long Range(Cells(6, 10), Cells(23, 10)) = "" Range(Cells(9, 2), Cells(21, 2)) = "" Range(Cells(6, 11), Cells(23, 11)) = "" With ListBox2 If .ListIndex = -1 Then '何も選択されていなければ MsgBox "何も選ばれていません" Exit Sub End If iiii = 6 rrrr = 0 For 選択行B = 0 To .ListCount - 1 If .Selected(選択行B) Then '選択されている行ならば ActiveSheet.Cells(iiii, 10) = .List(選択行B, 0) ActiveSheet.Cells(iiii, 11) = .List(選択行B, 1) If ActiveSheet.Cells(iiii, 2) = "" Then End If iiii = iiii + 1 Unload Me End If Next End With End Sub Private Sub Label11_Click() End Sub Private Sub Label2_Click() End Sub Private Sub ListBox1_Change() Dim ii As Long Dim DLastRow As Long Dim i As Long Dim c As Long DLastRow = Worksheets("データ").Range("D" & Rows.Count).End(xlUp).Row ListBox2.Clear With ListBox1 For 選択行B = 0 To ListBox3.ListCount - 1 If ListBox3.Selected(選択行B) Then 'ListBox3の選択されている行ならば For 選択行A = 0 To ListBox1.ListCount - 1 If .Selected(選択行A) Then 'ListBox1の選択されている行ならば For ii = 2 To DLastRow If ListBox3.List(選択行B, 0) = Worksheets("データ").Cells(ii, 3) And _ .List(選択行A, 0) = Worksheets("データ").Cells(ii, 4) Then ListBox2.AddItem Worksheets("データ").Cells(ii, 4).Value ListBox2.List(ListBox2.ListCount - 1, 1) = Worksheets("データ").Cells(ii, 5).Value ListBox2.List(ListBox2.ListCount - 1, 2) = Worksheets("データ").Cells(ii, 6).Value End If Next End If Next End If Next For c = ListBox2.ListCount - 1 To 1 Step -1 For i = c - 1 To 0 Step -1 If ListBox2.List(c, 0) = ListBox2.List(i, 0) And _ ListBox2.List(c, 1) = ListBox2.List(i, 1) Then ListBox2.RemoveItem c Exit For End If Next Next Dim rrr As Long Dim iii As Long For rrr = 0 To ListBox1.ListCount - 1 iii = 8 Do Until Cells(iii, 10) = "" If iii >= 22 Then Exit Sub End If If ListBox1.List(rrr, 1) = Cells(iii, 11).Value Then ListBox1.Selected(rrr) = True End If iii = iii + 1 Loop Next rrr End With End Sub Private Sub ListBox2_Change() Dim i As Long Dim rrrrr As Long Dim iiiii As Long Dim JLastRow As Long JLastRow = Range("J23").End(xlUp).Row iiiii = 0 For rrrrr = 0 To ListBox2.ListCount - 1 If ListBox2.Selected(rrrrr) = True Then iiiii = iiiii + 1 End If Next rrrrr Txt件数 = 18 - iiiii If Txt件数 < 0 Then MsgBox "これ以上登録できません。" End If End Sub Private Sub ListBox3_Change() 'ListBox1に、ListBox3で選択されているカテゴリーのメニューを追加 Dim c As Long Dim i As Long With ListBox1 .Clear .ColumnCount = 1 .BoundColumn = 0 .ColumnWidths = "80" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption .Visible = True End With With Worksheets("データ") For c = 0 To ListBox3.ListCount - 1 If ListBox3.Selected(c) Then For i = 2 To .Range("D" & Rows.Count).End(xlUp).Row If .Cells(i, "C") = ListBox3.List(c) Then If WorksheetFunction.CountIfs(.Range("C2:C" & i), .Cells(i, "C"), .Range("D2:D" & i), .Cells(i, "D")) <= 1 Then ListBox1.AddItem .Cells(i, "D").Value End If End If Next End If Next End With For c = ListBox1.ListCount - 1 To 1 Step -1 For i = c - 1 To 0 Step -1 If ListBox1.List(c) = ListBox1.List(i) Then ListBox1.RemoveItem c Exit For End If Next Next End Sub Private Sub Txt件数_Change() End Sub Private Sub UserForm_Initialize() Dim i As Long Dim r As Long Dim BLastRow As Long With Worksheets("データ") With ListBox3 .Clear .ColumnCount = 1 .BoundColumn = 0 .ColumnWidths = "80" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With With ListBox2 .ColumnCount = 3 .BoundColumn = 0 .ColumnWidths = "100;350;50" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With r = 0 For i = 2 To .Range("C" & Rows.Count).End(xlUp).Row If WorksheetFunction.CountIf(.Range("C2:C" & i), .Cells(i, "C")) <= 1 Then ListBox3.AddItem .Cells(i, "C").Value r = r + 1 End If Next End With ListBox1.Clear With Worksheets("データ") BLastRow = .Range("B" & Rows.Count).End(xlUp).Row r = 0 For i = 2 To BLastRow ListBox1.AddItem .Cells(i, 2).Value r = r + 1 Next With ListBox1 .ColumnCount = 1 .BoundColumn = 0 .ColumnWidths = "80" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With Dim rr As Long Dim ii As Long For rr = 0 To ListBox1.ListCount - 1 ii = 8 Do Until Cells(ii, 10) = "" If ListBox1.List(rr, 0) = Cells(ii, 10).Value Then ListBox1.Selected(rr) = True End If ii = ii + 1 Loop Next rr Dim rrr As Long Dim iii As Long For rrr = 0 To ListBox2.ListCount - 1 iii = 6 Do Until Cells(iii, 10) = "" If ListBox2.List(rrr, 1) = Cells(iii, 11).Value Then ListBox2.Selected(rrr) = True End If iii = iii + 1 Loop Next rrr End With ListBox1.Clear End Sub （Aya） 2021/09/07(火) 11:50 ---- 動いたようでよかったです。おつかれさまでした。 さて、余計なお世話ですが、気になった部分をコメントします。 （いつものように、動作に影響しませんのでスルーして構いません。 とはいえ、後日メンテナンスするときに見やすくなるかと思います） 1.ListBox1の初期化部分は、他と一緒のところがいいでしょう（*1部分） 2.ListBox3にListを書き込む部分で、変数rがありますが、何にも使われていません。 なくしてもいいでしょう（*2部分） 3.ListBox1をいじっているところがありますが、最後に「ListBox1.Clear」があるので 無意味です（*3部分） 4.同じく、ListBox2をいじっているところがありますが、ListBox2には何も追加されていないので 無意味です（*4部分） 5.順番が前後しましたが、ListBox1にリストを追加している部分がありますが、 最後に「ListBox1.Clear」があるので無意味です（*5部分） 6.ListBox3の初期化部分に「.Clear」があります。（*6部分） ListBox1とListBox2にも、同様にいれておいたらいかがでしょうか。 7.これは書く人の趣味の世界なのでとやかく言うことではありませんが、 ループに使う変数名は使い回しができますので、 i -> ii -> iii のように、毎回違うものにする必要はありません。 Private Sub UserForm_Initialize() Dim i As Long Dim r As Long Dim BLastRow As Long With Worksheets("データ") With ListBox3 .Clear ' これ（*6） .ColumnCount = 1 .BoundColumn = 0 .ColumnWidths = "80" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With '-- *1 をここへ移動してくる With ListBox2 .ColumnCount = 3 .BoundColumn = 0 .ColumnWidths = "100;350;50" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With r = 0 '-- *2 不要 For i = 2 To .Range("C" & Rows.Count).End(xlUp).Row If WorksheetFunction.CountIf(.Range("C2:C" & i), .Cells(i, "C")) <= 1 Then ListBox3.AddItem .Cells(i, "C").Value r = r + 1 '-- *2 不要 End If Next End With '--- ここから（*5） ListBox1.Clear With Worksheets("データ") BLastRow = .Range("B" & Rows.Count).End(xlUp).Row r = 0 For i = 2 To BLastRow ListBox1.AddItem .Cells(i, 2).Value r = r + 1 Next '--- ここまで 不要（*5） '--- ここから（*1） With ListBox1 .ColumnCount = 1 .BoundColumn = 0 .ColumnWidths = "80" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With '--- ここまで 上の方へ移動（*1） '--- ここから（*3） Dim rr As Long Dim ii As Long For rr = 0 To ListBox1.ListCount - 1 ii = 8 Do Until Cells(ii, 10) = "" If ListBox1.List(rr, 0) = Cells(ii, 10).Value Then ListBox1.Selected(rr) = True End If ii = ii + 1 Loop Next rr '--- ここまで 不要（*3） '--- ここから（*4） Dim rrr As Long Dim iii As Long For rrr = 0 To ListBox2.ListCount - 1 iii = 6 Do Until Cells(iii, 10) = "" If ListBox2.List(rrr, 1) = Cells(iii, 11).Value Then ListBox2.Selected(rrr) = True End If iii = iii + 1 Loop Next rrr End With '--- ここまで 不要（*4） ListBox1.Clear End Sub （きまぐれ） 2021/09/07(火) 13:23 ---- きまぐれ 様 ありがとうございます。 無駄なところだらけだったんですね… お恥ずかしい…。 不要箇所、削除しました。 また完成した際には、全コードコメントに残したいと思います。 Private Sub UserForm_Initialize() Dim i As Long Dim r As Long Dim BLastRow As Long With Worksheets("データ") With ListBox3 .Clear .ColumnCount = 1 .BoundColumn = 0 .ColumnWidths = "80" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With With ListBox1 .Clear .ColumnCount = 1 .BoundColumn = 0 .ColumnWidths = "80" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With With ListBox2 .Clear .ColumnCount = 3 .BoundColumn = 0 .ColumnWidths = "100;350;50" .MultiSelect = fmMultiSelectMulti .ListStyle = fmListStyleOption End With For i = 2 To .Range("C" & Rows.Count).End(xlUp).Row If WorksheetFunction.CountIf(.Range("C2:C" & i), .Cells(i, "C")) <= 1 Then ListBox3.AddItem .Cells(i, "C").Value End If Next End With ListBox1.Clear End Sub （Aya） 2021/09/08(水) 11:57... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/202108/20210816145809.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97021 documents and 608149 words.
訪問者：