一致する「発注番号」をリストボックスに表示したい 削除
| Message#2 2014年12月17日(水)17時26分 From: ポム |
| すみませんがExcel2007での確認です。大差ないと思いますが。。 エクセルのフィルタリング機能をVBA化して回答してみます。 １シートずつ（４シート分）を入力された｢名称｣｢番号｣よりフィルタリングして、フィルタリングされたデータのみListboxへの追加処理をしています。 Listbox1には結果として、データ順にそのまま表示されます。 （特に記載がなかったため｢発注番号｣の重複データもそのまま表示されます。） Option Explicit Private Sub CommandButton1_Click() '検索ボタンクリック時 Dim FilterRow As Range ListBox1.Clear 'リストボックス初期化 With ActiveWorkbook.Worksheets("交換(平成26年)") If .AutoFilterMode = True Then .AutoFilterMode = False 'フィルタモード解除 End If .Select Columns("E:G").Select Selection.AutoFilter ActiveSheet.Range("$E$1:$G$500").AutoFilter Field:=2, Criteria1:="=" & TextBox1.Text, _ Operator:=xlAnd ActiveSheet.Range("$E$1:$G$500").AutoFilter Field:=3, Criteria1:="=" & TextBox2.Text, _ Operator:=xlAnd 'フィルタされて表示されているデータをリストボックスへ For Each FilterRow In .Range("E1"). _ CurrentRegion.Resize(, 1).SpecialCells(xlVisible) If FilterRow.Row <> 1 Then '1行目(タイトル)は除外 'ListBox1へ追加 ListBox1.AddItem .Range("E" & FilterRow.Row).Value End If Next FilterRow .AutoFilterMode = False 'フィルタモード解除 .Range("E1").Select End With With ActiveWorkbook.Worksheets("解約(平成22〜24年)") If .AutoFilterMode = True Then .AutoFilterMode = False 'フィルタモード解除 End If .Select Columns("D:F").Select Selection.AutoFilter ActiveSheet.Range("$D$1:$F$500").AutoFilter Field:=2, Criteria1:="=" & TextBox1.Text, _ Operator:=xlAnd ActiveSheet.Range("$D$1:$F$500").AutoFilter Field:=3, Criteria1:="=" & TextBox2.Text, _ Operator:=xlAnd 'フィルタされて表示されているデータをリストボックスへ For Each FilterRow In .Range("D1"). _ CurrentRegion.Resize(, 1).SpecialCells(xlVisible) If FilterRow.Row <> 1 Then '1行目(タイトル)は除外 'ListBox1へ追加 ListBox1.AddItem .Range("D" & FilterRow.Row).Value End If Next FilterRow .AutoFilterMode = False 'フィルタモード解除 .Range("D1").Select End With With ActiveWorkbook.Worksheets("解約(平成25年)") If .AutoFilterMode = True Then .AutoFilterMode = False 'フィルタモード解除 End If .Select Columns("D:F").Select Selection.AutoFilter ActiveSheet.Range("$D$1:$F$500").AutoFilter Field:=2, Criteria1:="=" & TextBox1.Text, _ Operator:=xlAnd ActiveSheet.Range("$D$1:$F$500").AutoFilter Field:=3, Criteria1:="=" & TextBox2.Text, _ Operator:=xlAnd 'フィルタされて表示されているデータをリストボックスへ For Each FilterRow In .Range("D1"). _ CurrentRegion.Resize(, 1).SpecialCells(xlVisible) If FilterRow.Row <> 1 Then '1行目(タイトル)は除外 'ListBox1へ追加 ListBox1.AddItem .Range("D" & FilterRow.Row).Value End If Next FilterRow .AutoFilterMode = False 'フィルタモード解除 .Range("D1").Select End With With ActiveWorkbook.Worksheets("解約(平成26年)") If .AutoFilterMode = True Then .AutoFilterMode = False 'フィルタモード解除 End If .Select Columns("D:F").Select Selection.AutoFilter ActiveSheet.Range("$D$1:$F$500").AutoFilter Field:=2, Criteria1:="=" & TextBox1.Text, _ Operator:=xlAnd ActiveSheet.Range("$D$1:$F$500").AutoFilter Field:=3, Criteria1:="=" & TextBox2.Text, _ Operator:=xlAnd 'フィルタされて表示されているデータをリストボックスへ For Each FilterRow In .Range("D1"). _ CurrentRegion.Resize(, 1).SpecialCells(xlVisible) If FilterRow.Row <> 1 Then '1行目(タイトル)は除外 'ListBox1へ追加 ListBox1.AddItem .Range("D" & FilterRow.Row).Value End If Next FilterRow .AutoFilterMode = False 'フィルタモード解除 .Range("D1").Select End With 'カーソルを元に戻す With ActiveWorkbook.Worksheets("交換(平成26年)") .Select .Range("E1").Select End With End Sub |
上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。
