[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBA リストボックス追加』（Aya）
VBA初心者です。教えてください。
既存のVBAにリストボックスを追加したいと思っています。
?@List Box1の前にList Box3を追加
[List Box3の元データはデータシートのC列2行目以降を参照し、重複するものは表示しない]
?AList Box2の列の最後にデータシートF列2行目以降のデータも表示させる
[現在D,E列のデータが表示されているのでF列も追加したい]
以上2点を追記したいです。
不慣れで質問も不十分でしたらすみませんが、詳しい方おられましたら、よろしくお願いいたします。
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 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
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.
良い例が思いつかず、すみません。笑
こんな感じで5000件程のデータがあり、
1.List Box3："ｶﾃｺﾞﾘｰ"を選択
↓
2.List Box1：1.で絞られた"メニュー"のみが表示される
↓
3.List Box2：2.で絞られた"材料"を選択する
（List Box2には ﾒﾆｭｰ 材料 No. が表示されている）
あー、何度書き直してもわかりにくい説明ですみません。
ｶﾃｺﾞﾘｰとメニューでは重複を表示させたくないのですが、List Box2では、
サンプルデータにあるように、例えば”ニンジン”でも、
肉じゃがのニンジン、カレーのニンジン、ﾐﾈｽﾄﾛｰﾈのニンジン…と該当すれば重複していても表示させたいのです。
引き続きお願いいたします。
（Aya） 2021/08/17(火) 15:57
（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
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
コメントありがとうございます。
はい、List Box1〜3は複数選択ができるようにしたいです。
でもすみません。
VBAの知識がなさ過ぎて、tkit様が教えてくださったことを理解できるスペックもなく、
コードをどこに組み合わせればいいかもわかりません…
せっかく教えて頂いたのに、すみません…
どこにコードを組み合わせればいいかまで教えて頂けますでしょうか…
ほんとにすみません。
（Aya） 2021/08/18(水) 11:50
（きまぐれ） 2021/08/18(水) 12:58
Excelのバージョンは2016です。
ありがとうございます。
（Aya） 2021/08/18(水) 13:42
厚かましいお願いで申し訳ありませんでした。
でもわざわざコメントしてくださり、ありがとうございました。
もっとVBA勉強していきます。
（Aya） 2021/08/18(水) 13:45
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
そういうことなら・・・
・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
（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()へ移動して、１回だけ実行されればよいです。
※意味不明ならスルーしてください。
（きまぐれ） 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
また、変数「選択行B」に代入されていないのも原因の一つです。
（きまぐれ） 2021/08/25(水) 18:46
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
変数「選択行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
もしそうなら、エラーがでた行を教えて下さい。
（エラーがでたときに、「デバッグ」を押すと、黄色で表示されます）
（きまぐれ） 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
ListBox2の結果が重複するということでしょうか？
（おかずのカレーの材料 と スープのカレーの材料 がダブって出てくる）
こちらではこうなりますが、どうしたいですか？
ニンジン
じゃがいも
玉ねぎ
牛肉
ニンジン
じゃがいも
玉ねぎ
豚肉
1.単純に重複している項目を削除する。
⇒ 下段の「ニンジン」・・「玉ねぎ」が消えて「豚肉」が残る
2.別のカテゴリーで、同名のメニューが選択されているときは表示しない
⇒ スープのカレーの材料は「豚肉」ですが、無視されます
どちらにしましょうか？
（きまぐれ） 2021/08/30(月) 16:17
（きまぐれ） 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
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
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
（きまぐれ） 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
これ↓
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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.