コンボボックス連動 VBA

最近の書き込み件数：今日 0件、昨日 0件
未読分：3件

Excel VBAでIEを思いのままに操作できるプログラミング術 Excel 2013/2010/2007/2003対応

近田伸矢, 植木悠二, 上田寛

IEのデータ収集＆自動操作のプログラミング本はこの1冊だけ！IEの起動やポップアップウィンドウ、表示を制御する基本的なコードはもちろん、テキストボックスやラジオボタン、表、ハイパーリンクなどのHTML部品を制御する方法など、自動操作に欠かせないノウハウを丁寧に解説。

Message#3 2014年12月18日(木)19時51分
From: debuplis

返事削除変更

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

Message#2 2014年12月18日(木)15時22分
From: VBAマスター

返事削除変更

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

Message#1 2014年12月18日(木)15時22分
From: debuplis

返事削除変更

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