- 締切済み
コンボボックス 連動 VBA
VBA初心者です。 ご教授ください。 入力フォームにコンボボックスを4っつ リストボックスを一つ作成し 一つ目のコンボでシートを選択後 二つ目以降のコンボボックスでセル範囲を選択し絞り込み、最終のリストボックスに 絞り込み表示を行い、コマンドボタンにて フィルター操作を行いたいのですが 重複表示させずに、絞り込んでいく方法がうまくいきません。下記コードにコンボボックス3以降も記述したのですが、絞り込みができません。よろしくお願いします。 Private Sub UserForm_Initialize() For i = 2 To Worksheets.Count 'シートの数だけ繰り返す ComboBox1.AddItem Worksheets(i).Name '取得したシート名をリストボックスへ Next End Sub Private Sub ComboBox1_Change() Dim Index As Integer Dim strBuf As String Index = ComboBox1.ListIndex 'ワークシートリストの選択された位置 strBuf = ComboBox1.List(Index) 'ワークシート名を取得 Worksheets(strBuf).Activate ' セルA1を左上端にする Application.Goto Reference:=Range("A1"), Scroll:=True ComboBox2.Clear Dim リスト As New Collection Dim 列 As String, 上端セル As String, 最下端セル As String Dim セル範囲 As Range, 各セル As Range 列 = "b" '※3 上端セル = 列 & "4" '※4 最下端セル = 列 & "65536" With Worksheets(strBuf) '※5 Set セル範囲 = .Range(.Range(上端セル), .Range(最下端セル).End(xlUp)) End With For Each 各セル In セル範囲 'セル範囲の各セルについて繰り返し処理 On Error Resume Next '次行が実行時エラーならその次行から継続 リスト.Add 各セル.Value, CStr(各セル.Value) 'Collectionオブジェクトにメンバを追加 If Err.Number = 0 Then '実行時エラーが発生していなければ Me.ComboBox2.AddItem 各セル.Value 'コンボボックスのリストに項目を追加 End If On Error GoTo 0 Next End Sub
- みんなの回答 (1)
- 専門家の回答
みんなの回答
- watabe007
- ベストアンサー率62% (476/760)
>重複表示させずに、絞り込んでいく方法がうまくいきません。 ComboBoxのMatchFound プロパティを使えば良いでしょう Private Sub ComboBox1_Change() Dim Index As Integer Dim strBuf As String Dim セル範囲 As Range, 各セル As Range Index = ComboBox1.ListIndex strBuf = ComboBox1.List(Index) Worksheets(strBuf).Activate Application.Goto Reference:=Range("A1"), Scroll:=True ComboBox2.Clear With Worksheets(strBuf) Set セル範囲 = .Range("B4", .Cells(Rows.Count, "B").End(xlUp)) End With With Me.ComboBox2 For Each 各セル In セル範囲 .Text = 各セル.Value 'Textの値がリストに無ければTextの値を追加 If Not .MatchFound Then .AddItem 各セル.Value Next .Text = Empty '最後にTextに残る文字を消去 End With End Sub
お礼
ありがとうございます。 質問の記述方法がわかりにくいですよね? 回答のコードからコンボボックス2の選択リストよりコンボ3に内容をしぼりこむには?も教えていただけると幸いです。 ぶしつけな質問失礼いたします。