• 締切済み

コンボボックス 連動 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

みんなの回答

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

>重複表示させずに、絞り込んでいく方法がうまくいきません。 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

mizobekcs
質問者

お礼

ありがとうございます。 質問の記述方法がわかりにくいですよね? 回答のコードからコンボボックス2の選択リストよりコンボ3に内容をしぼりこむには?も教えていただけると幸いです。 ぶしつけな質問失礼いたします。

関連するQ&A

専門家に質問してみよう