エクセルのマクロを教えてください。

1行目はタイトル行
2行目以降、データがあります。

D列に数値がありますが
111、211、333以外をフィルターに掛けたいです。

その時、444があったら　A~Kを薄い青
222があったらA～Kを薄い緑　としたいです。

宜しくお願い致します。

No.3 ベストアンサー 回答者： tom04 回答日時： 2020/07/12 12:07

こんにちは！

オートフィルタのOR条件は二つしか設定できませんね。
ただ、一致条件であれば三つ以上でもオートフィルタで可能だと思いますが、
今回は除外条件が三つだというコトなので、オートフィルタ以外の方法になります。

一例です。

Sub 絞り込み()
　Dim i As Long
　Dim k As Long
　Dim myR As Range
　Dim myR1 As Range
　Dim myR2 As Range
　Dim myAry

　　myAry = Array(111, 211, 333) '//←除外データを追加可能//
　　Range("A:K").Interior.ColorIndex = xlNone
　　For i = 2 To Cells(Rows.Count, "D").End(xlUp).Row
　　　For k = 0 To UBound(myAry)
　　　　If Cells(i, "D") = myAry(k) Then
　　　　　If myR Is Nothing Then
　　　　　　Set myR = Cells(i, "D")
　　　　　Else
　　　　　　Set myR = Union(myR, Cells(i, "D"))
　　　　　End If
　　　　　　Exit For
　　　　Else
　　　　　If Cells(i, "D") = 444 Then
　　　　　　If myR1 Is Nothing Then
　　　　　　　Set myR1 = Cells(i, "A").Resize(, 11)
　　　　　　Else
　　　　　　　Set myR1 = Union(myR1, Cells(i, "A").Resize(, 11))
　　　　　　End If
　　　　　ElseIf Cells(i, "D") = 222 Then
　　　　　　If myR2 Is Nothing Then
　　　　　　　Set myR2 = Cells(i, "A").Resize(, 11)
　　　　　　Else
　　　　　　　Set myR2 = Union(myR2, Cells(i, "A").Resize(, 11))
　　　　　　End If
　　　　　End If
　　　　End If
　　　Next k
　　Next i
　　　If Not myR Is Nothing Then
　　　　myR.EntireRow.Hidden = True
　　　End If
　　　If Not myR1 Is Nothing Then
　　　　myR1.Interior.ColorIndex = 28 '//←色は好みで//
　　　End If
　　　If Not myR2 Is Nothing Then
　　　　myR2.Interior.ColorIndex = 35 '//こちらの色も好みで//
　　　End If
End Sub

※　条件付き書式が設定してある場合、そちらが優先され色の変化はありません。
条件付き書式の設定はクリアしてマクロを実行してみてください。

※　余計なお世話かもしれませんが、再表示の操作も必要だと思いますので
そのコードも記載しておきます。

Sub 再表示()
　ActiveSheet.Rows.Hidden = False
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

ありがとうございました。
採用させていただきます。

お礼日時：2020/07/12 13:31

No.2 回答者： ママチャリ 回答日時： 2020/07/12 11:59

参考になりそうなコードを書いてみました（参考なので、雑ですが・・・）。

こんな感じです。

Sub sample()
With Range("A1").CurrentRegion
.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Worksheets("Sheet2").Range("A1:A2"), Unique:=False
.Rows("2:" & .Rows.Count).Interior.Color = Worksheets("Sheet2").Range("A2").Interior.Color

.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Worksheets("Sheet2").Range("B1:B2"), Unique:=False
.Rows("2:" & .Rows.Count).Interior.Color = Worksheets("Sheet2").Range("B2").Interior.Color

.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Worksheets("Sheet2").Range("C1:E2"), Unique:=False
End With
End Sub

AdvancedFilterメソッドで、444を抽出して色付け。222を抽出して色付け。最後に111、211、333以外をフィルター掛けています。
AdvancedFilterメソッドで抽出条件を指定するために、Sheet2に添付画像のような設定が必要です。

No.1 回答者： Toshi_GPE 回答日時： 2020/07/12 10:34

マクロ使わなくても

条件書式で対応可能でしょ。