ExcelVBAのフィルタによる文字と背景色の複数条件検索
解決済
回答 3
投稿
- 評価
- クリップ 0
- VIEW 3,016
いつも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ページの「アクティブ」「注目」タブのフィードに表示されにくくなります。
質問の評価を下げたことを取り消します
この機能は開放されていません
評価を下げる条件を満たしてません
質問の評価を下げる機能の利用条件
この機能を利用するためには、以下の事項を行う必要があります。
- 質問回答など一定の行動
-
メールアドレスの認証
メールアドレスの認証
-
質問評価に関するヘルプページの閲覧
質問評価に関するヘルプページの閲覧
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
投稿
-
回答の評価を上げる
以下のような回答は評価を上げましょう
- 正しい回答
- わかりやすい回答
- ためになる回答
評価が高い回答ほどページの上位に表示されます。
-
回答の評価を下げる
下記のような回答は推奨されていません。
- 間違っている回答
- 質問の回答になっていない投稿
- スパムや攻撃的な表現を用いた投稿
評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。
+1
一度に出来ても、できなくても、
結果として自動実行させるのだから、
各条件で、順次絞り込めばいいだけでは?
その時に、「必要な物を抜き出す」という考えではなく、
逆に、
「不要なものをはじき出す(削除する)」と考えると、
作業手順が簡単になります。
今回の件の場合、
1)フィルターオプション機能で、東京を別のシートに抜き出す。
2)抜き出したデータからオートフィルターで黄色以外のセルを抽出し削除する
という手順で、順次ふるいにかけて行けば、欲しい結果が得られると思います。
その作業手順を自動化すればいいかと思います。
その時に、ユーザーにどのように入力&操作してもらうかと、
結果をどのように表示するかの画面設計も気になるところですが、
その作業の途中経過は見えないように出来るので、どのようにしても、
ユーザーは気にしないと思います。
処理速度が遅い場合は不満が出てくると思いますが、
高速化はとりあえずおいておいて、
まずは、ご自分の知識の範囲内で結果が出るように、
アプリを完成させてみてください。
投稿
-
回答の評価を上げる
以下のような回答は評価を上げましょう
- 正しい回答
- わかりやすい回答
- ためになる回答
評価が高い回答ほどページの上位に表示されます。
-
回答の評価を下げる
下記のような回答は推奨されていません。
- 間違っている回答
- 質問の回答になっていない投稿
- スパムや攻撃的な表現を用いた投稿
評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。
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
投稿
-
回答の評価を上げる
以下のような回答は評価を上げましょう
- 正しい回答
- わかりやすい回答
- ためになる回答
評価が高い回答ほどページの上位に表示されます。
-
回答の評価を下げる
下記のような回答は推奨されていません。
- 間違っている回答
- 質問の回答になっていない投稿
- スパムや攻撃的な表現を用いた投稿
評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。
15分調べてもわからないことは、teratailで質問しよう!
- ただいまの回答率 88.09%
- 質問をまとめることで、思考を整理して素早く解決
- テンプレート機能で、簡単に質問をまとめられる
2019/08/28 11:06
「抽出された項目の氏名をコピーして別シートに貼り付ける」というのが最終目的のようですので、
だとしたら、その配列を直接、出力先に代入してもいいかなと思いました。
2019/08/31 19:33
ベストアンサーを配列でやってくださったhatena19さんにするか、どちらにするか迷いましたが、元々フィルターベースで作っていましたので、こちらの方の回答をベストアンサーにしました。
無事にフィルターを掛けることに成功しました。ありがとうございました。