質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

フィルタ

フィルタとは、特定の条件に合わせてデータへのアクセスをブロックするプログラムやルーチンを指します。

Q&A

解決済

3回答

3118閲覧

ExcelVBAのフィルタによる文字と背景色の複数条件検索

k_shin

総合スコア17

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

フィルタ

フィルタとは、特定の条件に合わせてデータへのアクセスをブロックするプログラムやルーチンを指します。

0グッド

0クリップ

投稿2019/08/27 00:54

いつもterateilにてお世話になっております。
今回もVBA関連の質問をさせていただきます。よろしくお願いします。

作ろうとしているもの

ExcelでSheet1にある一覧表から、項目を検索して氏名の列をSheet2に貼り付けるVBAを作っています(以下の画像はSheet1)
イメージ説明
氏名の列より右の「性別」「出身地」「居住地」「血液型」を、Sheet2のA1セルに入力した文字を項目名として検索され、A2セルに入力された文字(=val)を検索語句として検索するようにしています。
フィルタにかけた後、抽出された項目の氏名をコピーして別シートに貼り付けるものです。

VBA

1ws01 = Sheet1 '一覧があるシート 2ws02 = Sheet2 '書き出し先のシート 3 4col_num = Worksheets(ws02).Range("A1") 5val = Worksheets(ws02).Range("A2") 6 7Worksheets(ws01).Range("A1").AutoFilter Field:=col_num, Criteria1:=val

ここから本題です…

VBAのフィルタに関する質問です。

画像にもあるように、黄色の背景色があるところは要注意項目のため、背景色があるセルをフィルタから除外したり、背景色がある項目だけ検索したいときがあります。
例えば「東京の背景色があるところ」と検索したいのです。

そこで、Criteria2にも追加して検索しようとしました(以下のプログラム)

VBA

1Worksheets(ws01).Range("A1").AutoFilter Field:=col_num, Criteria1:=RGB(255, 255, 0), Operator:=xlFilterCellColor, Criteria2:=val

しかし、黄色の背景色がある項目が全部抽出され、対象以外も出てきてしまって困っています。

色々と調べては見たものの、いまいちどうやればいいのかピンと来ていません。
文字と背景色を検索条件として共存させれば良いのか、ご教授ください。

また、難しいのであれば、どのように回避すべきかを教えていただければ大変助かります。
厚かましいと思いますが、よろしくお願いします。

使用環境 : Excel2013

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答3

0

一度に出来ても、できなくても、
結果として自動実行させるのだから、
各条件で、順次絞り込めばいいだけでは?

その時に、「必要な物を抜き出す」という考えではなく、
逆に、
「不要なものをはじき出す(削除する)」と考えると、
作業手順が簡単になります。

今回の件の場合、
1)フィルターオプション機能で、東京を別のシートに抜き出す。
2)抜き出したデータからオートフィルターで黄色以外のセルを抽出し削除する
という手順で、順次ふるいにかけて行けば、欲しい結果が得られると思います。
その作業手順を自動化すればいいかと思います。

その時に、ユーザーにどのように入力&操作してもらうかと、
結果をどのように表示するかの画面設計も気になるところですが、
その作業の途中経過は見えないように出来るので、どのようにしても、
ユーザーは気にしないと思います。
処理速度が遅い場合は不満が出てくると思いますが、
高速化はとりあえずおいておいて、
まずは、ご自分の知識の範囲内で結果が出るように、
アプリを完成させてみてください。

投稿2019/08/27 23:41

mattuwan

総合スコア2136

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

k_shin

2019/08/31 10:34

回答ありがとうございます。今後の参考にさせていただきます。 ありがとうございました。
guest

0

ベストアンサー

前の方が仰っているように、通常のAutoFilterではできず、作業列を使うのがベストだと思うのですが、今回試しに、絞り込む内容の入った配列を作り、Operator:=xlFilterValuesでその配列をもとにフィルターするコードを書いてみたので参考になればと思います。

vba

1Sub filter() 2Dim Val As String 3Dim col_num, i As Integer 4Dim Arr() As String: ReDim Arr(0) '空の配列を作成 5col_num = Range("B11").Value 'セルB11をcol_numに代入 6Val = Range("C11") 'セルC11をVal(フィルターするキーワード)に代入 7For i = 2 To Cells(2, col_num).End(xlDown).Row '表の最下行までループ 8 If Cells(i, col_num).Interior.Color = RGB(255, 255, 0) And Cells(i, col_num) = Val Then 9 '「背景色が黄色」かつ「内容がValと一致」した場合の処理 10 ReDim Preserve Arr(UBound(Arr) + 1) '配列を一つ増やす 11 Arr(UBound(Arr)) = Cells(i, 1) '条件に合致する行の一列目の内容(氏名)を配列に追加 12 End If 13Next i 14Range("A1").AutoFilter Field:=1, Criteria1:=Arr, Operator:=xlFilterValues 15 '配列Arrに含まれる行のみをフィルター 16End Sub

イメージ説明

投稿2019/08/27 11:42

ryunenfukahi

総合スコア34

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

hatena19

2019/08/28 02:06

配列でフィルターをかけるというのはいいアイデアだと思います。 「抽出された項目の氏名をコピーして別シートに貼り付ける」というのが最終目的のようですので、 だとしたら、その配列を直接、出力先に代入してもいいかなと思いました。
k_shin

2019/08/31 10:33

返信が遅くなってすいません。出張に行ってまして、遅れてしまいました。 ベストアンサーを配列でやってくださったhatena19さんにするか、どちらにするか迷いましたが、元々フィルターベースで作っていましたので、こちらの方の回答をベストアンサーにしました。 無事にフィルターを掛けることに成功しました。ありがとうございました。
guest

0

AutoFilterだけの機能では無理だと思います。

作業列を使う方法がよく使われます。

Office TANAKA - Excel VBA Tips[オートフィルタ[作業列で絞り込む]]

複雑な条件(複数除外等)のオートフィルター(AutoFilter)|VBA技術解説

追記

フィルタにかけた後、抽出された項目の氏名をコピーして別シートに貼り付けるものです。

フィルターは手段で最終目的が該当する氏名のコピーなら、
オートフィルターは使わずに、
VBAで該当する氏名を配列に格納して、
それを出力先に代入すればシンプルになるでしょう。

コード例

vba

1Sub NameCopy() 2 Dim ws01 As Worksheet: Set ws01 = Sheet1 3 Dim ws02 As Worksheet: Set ws02 = Sheet2 4 Dim col_Num As Long: col_Num = ws02.Range("A1") 5 Dim val As String: val = ws02.Range("A2") 6 Dim maxRow As Long: maxRow = ws01.Cells(1, 1).End(xlDown).Row 7 '該当する名前の格納用配列(最大数分確保しておく) 8 Dim aryName() As String: ReDim aryName(maxRow - 2) 9 10 Dim i As Long, cnt As Long 11 For i = 2 To maxRow 12 With ws01.Cells(i, col_Num) 13 If .Interior.Color = vbYellow And .Value = val Then 14 aryName(cnt) = ws01.Cells(i, 1) 15 cnt = cnt + 1 16 End If 17 End With 18 Next 19 ws02.Range("B:B").ClearContents 20 '名前配列を縦横変換して代入、代入するセル範囲のサイズを該当件数で制限しておく 21 ws02.Range("B1").Resize(cnt).Value = WorksheetFunction.Transpose(aryName) 22End Sub 23

投稿2019/08/27 02:58

編集2019/08/28 02:02
hatena19

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

k_shin

2019/08/31 10:34

回答ありがとうございます。 追記でコードを書いてくださり、ありがとうございます。今後の参考にさせていただきます。 ありがとうございました。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問