[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロ オートフィルタで”〜以外”を削除したい』（勉強中）
マクロ勉強中ですが、下記で息詰まっています。アドバイス頂けますと幸いです。
A B C D E F
1 種類 a,あ,d
2 No. 数量 種類
3 1 2 a
4 2 3 b
5 3 4 a
6 4 2 c
7 5 1 あ
8 6 2 あ
9 7 3 b
10 8 5 d
11 9 3 a
12 10 3 a
13 11 3 a
14 12 2 d
15 13 2 c
16 14 1 い
17 15 5 あ
Sheet1に上記のような表（A-C列）があります。
やりたい事は、F1セルにある文字（a,あ,d)を検索条件として、
もし、C列の種類がF1セルと一致しなければ行ごと削除したいです。
つまり、a, あ, dの行は残したいです。
しかし、色々考えてa, あ, dと一致するものを削除は出来たのですが、本来やりたいその逆が出来ません。
考えたコード
Sub 並び替え()
Dim ListArray As String
Dim arr As Variant
Dim i As Long
arr = Split(Sheets("Sheet1").Range("F1").Value, ",")
For i = LBound(arr) To UBound(arr)
Sheets("Sheet1").AutoFilterMode = False
Sheets("Sheet1").Range("A2").AutoFilter Field:=3, Criteria1:=arr(i), Operator:=xlFilterValues
Application.DisplayAlerts = False
With Sheets("Sheet1").Range("A2").CurrentRegion
.Resize(.Rows.Count - 1).Offset(1, 0).Delete
End With
Application.DisplayAlerts = True
Sheets("Sheet1").Range("A2").AutoFilter
Next i
End Sub
〜”以外”でオートフィルタ検索する際は、
Criteria1:="<>" & arr(i) のように、"<>"でできる所までは分かったのですが、
配列arr(i)でループしているために、これでやると、まず「a」以外を削除してしまうので、その時点で「あ」と「d」も消えてしまいます。
どのようにやれば、Splitで取得した変数をオートフィルターで〇〇以外削除できますでしょうか？
＜ 使用 Excel：Microsoft365、使用 OS：Windows10 ＞
一番簡単なのは数式を使用して一致するしないを判定、作業列にフラグを立てて絞り込むことだと思います。
以下は数式ではなく、一度「等しい」で絞り込み、フラグを立てて再度空白セルを対象に絞り込む方法です。
※２回オートフィルターを使用するので、数式でやったほうがいいと思います。
Sub test()
Dim s
s = Split(Range("F1"), ",")
Range("A1").AutoFilter 3, s, xlFilterValues
With Range("A2").CurrentRegion.Offset(1, 3)
.Resize(.Rows.Count - 1, 1) = 1
End With
Range("D2") = "作業列"
Range("A1").AutoFilter
Range("A1").AutoFilter 4, ""
With Range("A2").CurrentRegion.Offset(1, 0)
.Resize(.Rows.Count - 1).EntireRow.Delete
End With
Range("A1").AutoFilter
Columns(4) = ""
End Sub
（フォーキー） 2023/06/14(水) 22:49:29
Sub test2()
Range("D2") = "作業列"
Range("D3").Resize(Cells(Rows.Count, "A").End(xlUp).Row - 2).Formula2 = "=ISERROR(SEARCH(C3,$F$1))"
Range("A1").AutoFilter 4, True
With Range("A2").CurrentRegion.Offset(1, 0)
.Resize(.Rows.Count - 1).EntireRow.Delete
End With
Range("A1").AutoFilter
Columns(4) = ""
End Sub
（フォーキー） 2023/06/14(水) 23:07:58
ISERRORとSEARCHの組み合わせで判定させればよいのですね。
オートフィルタ2回使用バージョンは問題なく動きました。
一つ質問させてください。
Range("A1").AutoFilter
Range("A1").AutoFilter 4, ""
の所で、A1セルを選択しているのはなぜかが分かりませんでした。
感覚的には、A2セルから表が始まっているので、A2セルを指定するのかと思っていたのですが。
どちらもやってみたら、両方とも結果は同じになりますが、今後の理解のために教えて頂けますと幸いです。
（勉強中） 2023/06/14(水) 23:23:07
フィルタオプション（AdvancedFilter)を使う例です。条件の個数上限はありません（たぶん）
A列 B C D E F G
1 種類 種類 種類
2 No. 数量 種類 <>a <>あ <>d
3 1 2 a
4 2 3 b
5 3 4 a
6 4 2 c
7 5 1 あ
.. （中略）..
16 14 1 い
17 15 5 あ
コードは以下です。
Sub test()
Range("A2:C17").AdvancedFilter _
Action:=xlFilterInPlace, _
CriteriaRange:=Range("E1:G2"), _
Unique:=False
Range("A3:C17").EntireRow.Delete
ActiveSheet.ShowAllData
End Sub
説明の都合上、セル範囲は汎用的にしていません。 実際に使用する際は、CurrentRegionなどで工夫して下さい。
（xyz） 2023/06/14(水) 23:48:31
Sub test3()
Dim s
s = Split(Range("F1"), ",")
Range("A1").AutoFilter 3, s, xlFilterValues
With Range("A2").CurrentRegion.Offset(1, 3)
.Resize(.Rows.Count - 1, 1) = 1
End With
Range("D2") = "作業列"
On Error Resume Next
ActiveSheet.AutoFilter.Range.Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Range("A1").AutoFilter
Columns(4) = ""
End Sub
>Range("A1").AutoFilter
オートフィルタの引数をすべて省略すると、範囲内のフィルタが解除される仕様になっています。
＞A1セルを選択しているのはなぜかが分かりませんでした。
手動でフィルタをかけてみるとわかると思いますが、A1からC1が空白の状態でA1セルを選択すると、2行目の見出し行にドロップダウンの表示が出ます。
逆に1行目が入力されている場合は、1行目にドロップダウンが出ます。
私も詳しくないですが、1行目が空欄なら自動的に一つ下の行を対象にしてくれるらしいです。
たとえ1行目が埋まっていても、オートフィルタ自体は実行できるので問題ないです。
（フォーキー） 2023/06/14(水) 23:52:24
>アプリケーション定義またはオブジェクト定義のエラーが出てしまいました。 多分違うと思いますが、Formula2をFormulaに変えたらどうなりますか？ （フォーキー） 2023/06/14(水) 23:56:20
G1:G2を作業セルとして使います 数式をアドバンスドフィルターの条件にしています
Sub sample()
Range("G1:G2").ClearContents
Range("G2").Formula = "=ISNA(MATCH(C3,TEXTSPLIT($F$1,"",""),0))"
Range("A2").CurrentRegion.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("G1:G2"), Unique:=False
End Sub
（´・ω・`） 2023/06/15(木) 00:20:23
xyz様、（´・ω・`）様
フィルタオプションで、このように短いコードで可能なのですね。
実際のデータは行数が大量にあるので、ループで削除では時間がかかりすぎるので、
フィルタオプションもアドバイス頂いた事例を参考に勉強してみます。
ありがとうございます。
フォーキー様
＞Formula2をFormulaに変えたらどうなりますか？
変えたら動きました。ありがとうございます。
また、A1セルを選択する理由のご説明もありがとうございます。
実際に手動で試してみて理解しました。（1-3行目が空欄だとA1セルではダメだが、表に隣接した一つ上の空欄なら反応するのですね）
オートフィルタは項目名の行が結合していたら…とか、意外とマクロでやろうとすると難しいですね。
＞フィルタかけた状態から空白行を削除するだけなら↓で可能でした。
SpecialCells(xlCellTypeBlanks)というものがあるのですね。大変参考になります。
色々とアドバイス頂き、ありがとうございました。
今後も頑張って習得していきたいと思います。
（勉強中） 2023/06/15(木) 07:04:52
＞しかし、色々考えてa, あ, dと一致するものを削除は出来たのですが ＞本来やりたいその逆が出来ません。
逆バージョンです。
【 条件 】
＊空白セルは、削除対象外 ＊セル値は、下記のように設定
|[F]|[G]|[H]
[1]|a |d |あ
Sub AutoFilter_Sample()
Dim sRng As Range, eRng As Range, tRng As Range
Dim v, vStr, vUniq(), Keyword, n As Long, LastR As Long
With Sheets(1)
LastR = .Cells(.Rows.count, 3).End(xlUp).Row
Set sRng = .[C3]
Set eRng = .Cells(LastR, sRng.Column)
Set tRng = .Range(sRng, eRng)
'C列の重複を削除して、削除キーを配列にする
For Each v In Application.Unique(tRng, False)
Select Case v
Case .[F1], .[G1], .[H1] ' 種類 a,あ,d (左から)
Case Else: n = n + 1: ReDim Preserve vUniq(n)
vUniq(n) = v
End Select
Next v
'削除キーを登録 : b,c,い
Keyword = vUniq
With .[A2].CurrentRegion
.AutoFilter
.AutoFilter 3, Keyword, xlFilterValues
.Offset(1, 0).Resize(.Rows.count - 1).EntireRow.Delete
.AutoFilter
End With
End With
End Sub
[ Uniqueメソッドについて ] プリインストールされている、Excelでは使用できないかも？ Office365 は使用可能(きっと)
※動かない場合は、すいませんが [ゴミ箱]へ、ぴょぉおん、おねがいしま〜す。(o_ _)o （あみな） 2023/06/15(木) 17:03:15
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.