Excelシート(Sheet1)にComboBox1とComboBox2とComboBox3を配置しています。
Sheet1のA列とB列とC列に下記のように「分類」「品目」「生産地」一覧が入力されています。
A B C
1 分類 品目 生産地
2 やさい キャベツ 千葉
3 くだもの もも 山梨
4 やさい キャベツ 茨城
5 やさい じゃがいも 北海道
6 くだもの みかん 愛媛
ファイルOPEN時に「分類」「品目」「生産地」をそれぞれComboBoxに重複を除いて表示しています。
たとえば、ComboBox1の「分類」で”やさい”を選択されたら、ComboBox2の「品目」は、
重複を除いた”キャベツ”と”じゃがいも”が表示されるようにしたいのですが、どうしたらよいのでしょうか。
下記まではできたのですが、”キャベツ””キャベツ””じゃがいも”と重複データがそのまま表示されてしまいます。
ご教授下さい。
Private Sub ComboBox1_Change()
Dim c, first As String
ComboBox2.Clear
With Worksheets("Sheet1").Range("A2:A30")
Set c = .Find(Me.ComboBox1.Text, LookIn := xlValues)
If Net c Is Nothing Then
first = c.Row
Do
ComboBox2.AddItem Worksheets("Sheet1").Cells(c.Row,2).Value
Set c = .Find Next(c)
Loop While Not c Is Nothing And c.Row <> first
End If
End With
End Sub
参考に
Private Sub ComboBox1_Change()
Dim myDic As Object
Dim c As Range
Set myDic = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet1")
For Each c In .Range("A2", .Cells(Rows.Count, "A").End(xlUp))
If ComboBox1.Value = c.Value Then myDic(c.Offset(, 1).Value) = Empty
Next
End With
Me.ComboBox2.List = myDic.Keys
Set myDic = Nothing
End Sub
Do
ComboBox2.AddItem Worksheets("Sheet1").Cells(c.Row,2).Value
Set c = .Find Next(c)
Loop While Not c Is Nothing And c.Row <> first
の部分でコンボボックスにすでに格納されているデータとの重複を調べて
重複していなければセットしなければいい
ただ、コンボボックスにすでに格納されているデータと比較するのは処理が重たくなるので
コンボボックスにセットしてある値を配列にもってセットするのが無難、
また、worksheets().cells().valueも同じく変数に一回格納して利用するのが無難と思います。
ということで例です。（上記の部分に関するところについてのみ記載しています。）
dim flag as string '"Find" または "NotFind"
dim wkStr as string 'シート上の値を一時格納
dim setItemData()
redim setItemData(0)
dim ix1 as single
Do
wkstr =Worksheets("Sheet1").Cells(c.Row,2).Value
flag = "Not Find" '最初（見つからなかったらこの値）
for ix1 = 1 to ubound(setItemData)
if setItemData(ix1) = wkstr then
flag = "Find" '見つかったとき
exit for
end if
next
if flag = "Not Find" then
ComboBox2.AddItem wkstr
redim preserve setItemData(ubound(setItemData) + 1) '配列を１個ふやす
setItemData(ubound(setItemData)) = wkst '配列の最大番号のところ（＝今増やしたところ）に値を入れる。
end if
Set c = .Find Next(c)
Loop While Not c Is Nothing And c.Row <> first
