画面上にコンボボックス1,2,3があり、入力リストをdatasheetから表示します。
(やりたいこと、実現したいこと)
入力リスト"datasheet"に空白行がある場合、下記のようにコンボボックス2に空白行が表示されました。もちろん間違いではないのですが、ユーザーにそれを選択して欲しくないため、上に詰めることはできますでしょうか。もし詰めることができない時は、空白行を選択したら、エラーメッセージにすればいいのでしょうか。
よろしければ、ご教授いただけませんでしょうか、よろしくお願いいたします。
VBA
1Private Sub ComboBox2_Change() 2 3 Dim MyData3 As New Collection 4 Dim cnt3 As Long 5 Dim i3 As Long 6 Dim ProductName As Variant '製品名 7 Dim Size As Variant 'サイズ 8 9 cnt3 = Sheets("datasheet").Range("A1").CurrentRegion.Rows.Count 10 11 ProductName = ComboBox1.Text 12 Size = ComboBox2.Text 13 14 ComboBox3.Clear 15 16 'On Error Resume Next 17 For i3 = 2 To cnt3 18 If CStr(Sheets("datasheet").Range("B" & i3).Value) = ProductName _ 19 And CStr(Sheets("datasheet").Range("C" & i3).Value) = Size Then 20 key = CStr(Sheets("datasheet").Range("D" & i3).Value) 21 If isExists(MyData3, key) = False Then 22 MyData3.Add key, key 23 End If 24 End If 25 Next i3 26 'On Error GoTo 0 27 28 For i3 = 1 To MyData3.Count 29 ComboBox3.AddItem MyData3(i3) 30 Next 31 32End Sub 33Private Sub ComboBox1_Change() 34 Dim MyData2 As New Collection 35 Dim cnt2 As Long 36 Dim i2 As Long 37 Dim key As Variant 38 Dim ProductName As Variant '製品名 39 40 cnt2 = Sheets("datasheet").Range("A1").CurrentRegion.Rows.Count 41 42 ProductName = ComboBox1.Text 43 44 ComboBox2.Clear 45 46 '■重複しないProductNameのリストを作成 47 'On Error Resume Next 48 For i2 = 2 To cnt2 49 If CStr(Sheets("datasheet").Range("B" & i2).Value) = ProductName Then 50 key = CStr(Sheets("datasheet").Range("C" & i2).Value) 51 If isExists(MyData2, key) = False Then 52 MyData2.Add key, key 53 End If 54 End If 55 Next i2 56 'On Error GoTo 0 57 58 '■ProductNameのリストを作成 59 60 For i2 = 1 To MyData2.Count 61 ComboBox2.AddItem MyData2(i2) 62 Next 63 64 65End Sub 66 67Private Sub UserForm_Initialize() 68 Dim MyData1 As New Collection 69 70 Dim cnt As Long 71 Dim i As Long 72 Dim key As Variant 73 74 cnt = Sheets("datasheet").Range("A1").CurrentRegion.Rows.Count 75 76 '■重複しないProductNameのリストを作成 77 'On Error Resume Next 78 For i = 2 To cnt 79 key = CStr(Sheets("datasheet").Range("B" & i).Value) 80 If isExists(MyData1, key) = False Then 81 MyData1.Add key, key 82 End If 83 Next i 84 'On Error GoTo 0 85 86 87 '■ProductNameのリストを作成 88 89 For i = 1 To MyData1.Count 90 ComboBox1.AddItem MyData1(i) 91 Next 92 93End Sub 94' Collectionの中にすでに登録されているか確認 95Function isExists(col As Collection, item As Variant) As Boolean 96 Dim Var As Variant 97 For Each Var In col 98 If Var = item Then 99 isExists = True 100 Exit Function 101 End If 102 Next Var 103 isExists = False 104End Function 105
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2020/10/17 10:43