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

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

質問する

ただいまの
回答率

88.09%

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

解決済

回答 3

投稿

  • 評価
  • クリップ 0
  • VIEW 3,016
k_shin

score 17

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

作ろうとしているもの

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

ws01 = Sheet1 '一覧があるシート
ws02 = Sheet2 '書き出し先のシート

col_num = Worksheets(ws02).Range("A1")
val = Worksheets(ws02).Range("A2")

Worksheets(ws01).Range("A1").AutoFilter Field:=col_num, Criteria1:=val

ここから本題です…

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

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

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

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


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

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

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

使用環境 : Excel2013

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

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

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

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 3 件

checkベストアンサー

+1

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

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


イメージ説明

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/08/28 11:06

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

    キャンセル

  • 2019/08/31 19:33

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

    キャンセル

+1

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

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

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

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

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/08/31 19:34

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

    キャンセル

0

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

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

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

複雑な条件（複数除外等）のオートフィルター（AutoFilter）｜VBA技術解説

追記

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

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

コード例 

Sub NameCopy()
    Dim ws01 As Worksheet: Set ws01 = Sheet1
    Dim ws02 As Worksheet: Set ws02 = Sheet2
    Dim col_Num As Long:   col_Num = ws02.Range("A1")
    Dim val As String:     val = ws02.Range("A2")
    Dim maxRow As Long:    maxRow = ws01.Cells(1, 1).End(xlDown).Row
    '該当する名前の格納用配列（最大数分確保しておく）
    Dim aryName() As String: ReDim aryName(maxRow - 2)

    Dim i As Long, cnt As Long
    For i = 2 To maxRow
        With ws01.Cells(i, col_Num)
            If .Interior.Color = vbYellow And .Value = val Then
                aryName(cnt) = ws01.Cells(i, 1)
                cnt = cnt + 1
            End If
        End With
    Next
    ws02.Range("B:B").ClearContents
    '名前配列を縦横変換して代入、代入するセル範囲のサイズを該当件数で制限しておく
    ws02.Range("B1").Resize(cnt).Value = WorksheetFunction.Transpose(aryName)
End Sub

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/08/31 19:34

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

    キャンセル

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

  • ただいまの回答率 88.09%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる
質問する

関連した質問

同じタグがついた質問を見る

SNSアカウントでログイン

teratailアカウントでログイン

思考するエンジニアのためのQ&Aサイト「teratail」について詳しく知る