コンボボックスの連動

質問

こんにちは！

今回もVBAで分からないことがあったため、質問させて頂きます。
Excelは2003を使用しています。

画像のようなデータが、A1：D？まであったとします。
A列、B列、C列などの重複しないデータをプログラムを用いて
同じシート内（例として、「管理」シートとします。）に記載しています。

そのデータをコンボボックス上に表示することはできました。

そして、次にコンボボックス上に表示されたデータを選択した際に、
フィルターで絞込みをするように設定しています。
（図の例でいくと、りんごで絞込み）

「りんご」で絞込みをかけた際に、実際のリスト上にある
重複しないデータをコンボボックスに入れなおしたい？です。

重複しないデータの抽出方法が悪いとは思うのですが、
可視セル（指定列）の重複しないものを書くことはできるのでしょうか？

たぶん、重複しないデータを抽出する際の
範囲指定が悪いと思います。

色々書いてわからなくなったため、
やりたいことをまとめさせて頂きます。
●コンボボックスを押した際にフィルター絞込み（これは出来てます）
●絞り込んだ後、その他の列の重複しないデータをコンボボックスに入れなおす

あと別途、
●可視セル(タイトル行を除く）の範囲選択＆データ取得方法（重複しないデータ取得も）
●フィルターをかけた際に、絞込み結果が0（空白）の場合、メッセージボックスを表示

情報不足かもしれませんが、回答よろしくお願い致します。

EndLineは、A1から下に下がった行番号を格納しています。（例)9
----------------------------------------------

On Error Resume Next 'データを登録する間、エラーを無視する

For i = 2 To EndLine '最終行までチェック
Mydata.Add Range("B" & i).Value, Range("B" & i).Value '名前の列の重複確認
Next i
On Error GoTo 0

'重複していないデータがMydataに格納されていく

For Each A In Mydata 'Mydataの内容をセルに書き出す。
Worksheets("管理").Cells(i, ROW_NUMBER).Value = A
i = i + 1

Next A

End Function
-------------------------------------------------

Function Combo_KOUSIN() 'コンボボックスのデータ更新
Dim EndLine As Long
Dim i As Long

ComboBox1.Clear

EndLine = EndCheck("F") '　”F”　列の行数抽出
For i = 1 To EndLine
ComboBox1.AddItem Range("F" & i).Value
Next

上と同様に、combobox2,3,4も行う。
F列、G列、H列、I列などに重複しないデータがあります。
それを取得して、ComboBoxに格納します。

回答No.1

mitarashi · ベストアンサー

オートフィルタでできる事をわざわざUserFormでやろうという目的は何でしょうか？
お示しのコードは全く気にせず書いてみました。重複しないリストはシート上のF～I列?の値は用いず、都度取得しています。
また、オートフィルタの範囲取得は手を抜いているので、E列は空でないと誤動作します。UserFormモジュールです。

Dim sh As Worksheet
Dim targetRange As Range
'オートフィルタの見出し行以外の範囲を収納
Dim listRange As Range
'DropButtonClickでリストを設定しているため、イベント重複発生防止用
Dim comboSetFlag(1 To 4) As Boolean

Private Sub UserForm_Initialize()
Set sh = Sheets(1)
Set targetRange = sh.Range("A1").CurrentRegion
Set listRange = Intersect(targetRange, targetRange.Offset(1, 0))
End Sub

'コンボボックスは改名しない、お仕着せのComboBox?のままとしています
Private Sub UserForm_Terminate()
'sh.AutoFilterMode = False
End Sub

Private Sub ComboBox1_Change()
setAutofilter Me.ActiveControl
End Sub
'都度全てのComboBoxのリストを設定するのは重いかと思い、ドロップダウンをクリックした時動的にリストを生成させてみた
Private Sub ComboBox1_DropButtonClick()
setComboBox Me.ActiveControl
End Sub
'以下ComboBox2～ComboBox4も同様
Private Sub ComboBox2_Change()
setAutofilter Me.ActiveControl
End Sub

Private Sub ComboBox2_DropButtonClick()
setComboBox Me.ActiveControl
End Sub

’（中略）

Sub setAutofilter(myComboBox As Object)
Dim myColumnNo As Long
' Dim filteredNo As Long

myColumnNo = Val(Replace(myComboBox.Name, "ComboBox", ""))
targetRange.AutoFilter field:=myColumnNo, Criteria1:=CStr(myComboBox.Value)
' 重複しないリストを取得してフィルターをかけている以上、該当無しになる事はないのでは？
' filteredNo = Application.WorksheetFunction.Subtotal(3, listRange.Columns(myColumnNo))
' If filteredNo = 0 Then
' MsgBox "該当無し"
' Exit Sub
' End If
comboSetFlag(myColumnNo) = False
End Sub

Sub setComboBox(myComboBox As Object)
Dim myColumnNo As Long
' Dim filteredNo As Long

myColumnNo = Val(Replace(myComboBox.Name, "ComboBox", ""))
' 重複しないリストを取得してフィルターをかけている以上、該当無しになる事はないのでは？
' filteredNo = Application.WorksheetFunction.Subtotal(3, listRange.Columns(myColumnNo))
' If filteredNo = 0 Then Exit Sub
If Not comboSetFlag(myColumnNo) Then
myComboBox.List = getUniqueList(listRange.Columns(myColumnNo).SpecialCells(xlCellTypeVisible))
comboSetFlag(myColumnNo) = True
End If
End Sub

'重複しないリストの取得は連想配列を用いています。VBA Dictionaryでお調べ下さい。
Function getUniqueList(srcRange As Range) As Variant
Dim myCell As Range, myArea As Range
Dim myDic As Object

Set myDic = CreateObject("Scripting.Dictionary")
For Each myArea In srcRange.Areas
For Each myCell In myArea.Cells
If Not myDic.exists(myCell.Value) Then
myDic.Add myCell.Value, ""
End If
Next myCell
Next myArea
getUniqueList = myDic.keys
Set myDic = Nothing
End Function

お礼

回答ありがとうございます。
>オートフィルタでできる事をわざわざUserFormでやろうという目的は何でしょうか？
→上司に、オートフィルタのチェックを外したり色々面倒だ
　フォームを作って、別シートに抽出した項目を
　きれいに並べて書きだして

といわれたため、作成しています。

>重複しないリストを取得してフィルターをかけている以上、該当無しになる事はないのでは？
選択した都度重複しないリストを更新しなければならず、その手段がわかっていなかったのです。

目的のものを作ることが出来ました！
回答ありがとうございました。