導入

VBAでオートフィルタを扱う方法を調べていた際に、Office TANAKAさんの記事¹で以下の記載を目にしました。

f:id:e0m0jelly:20210719172054p:plain — 図01_Office TANAKAさんの記事

日付を年単位や月単位などで絞り込み条件を設定すると、その条件がVBAから見えなくなるのです。
これはかなり衝撃的でした。
ユーザーが設定した任意の絞り込み条件を、消した後に元に戻す仕組みがVBAには無いという事を意味しますからね。
この様な状況であってもオートフィルタの絞り込み条件を保持・再適用するアイデアを、この記事では紹介します。

アイデアの内容

Excelの以下の性質を利用します。

Excelの性質

セルの挿入／削除を行うと、オートフィルタのセル範囲が自動で拡張／縮小される。

おそらくExcel作業でオートフィルタを触ったことがある方は、身に覚えがあると思います。
この性質を利用したアイデアは次の通りです。

オートフィルタの絞り込み条件を保持・再適用するアイデア

編集後データの用意
絞り込み条件を再適用したい編集後データを、対象のオートフィルタとは別に用意する。

対象のオートフィルタのセル範囲拡張
編集後データ分のセルを挿入し、対象のオートフィルタのセル範囲を拡張させる。

データの差し替え
拡張されたセル範囲に編集後データを貼り付ける。
編集前データのセルを削除し、対象のオートフィルタのセル範囲を縮小させる。

絞り込み条件の再適用
設定されている絞り込み条件を再適用する。

具体的なイメージを順に説明していきます。
例として、以下の様な絞り込み条件が適用されたオートフィルタを扱う事にします。

f:id:e0m0jelly:20210719222107p:plain — 図02_【例】任意の絞り込み条件が適用されたオートフィルタ

1.編集後データの用意

以下の図03を見てください。
前述の図02【例】任意の絞り込み条件が適用されたオートフィルタから絞り込み条件を解除した状態が左側で、何らかの編集後の状態（絞り込み条件を再適用したい編集後データ）が右側だとします。
この右側の状態（編集後データのセル）を、別シートや別ブックなどで対象のオートフィルタとは別に用意しておきます。

f:id:e0m0jelly:20210719224526p:plain — 図03_【例】編集前データと編集後データ

2.対象のオートフィルタのセル範囲拡張

対象のオートフィルタに絞り込み条件が適用されたままの状態で、編集後データ分のセルを挿入し、対象のオートフィルタのセル範囲を拡張させます。

f:id:e0m0jelly:20210719231331p:plain — 図04_【例】編集後データ分のセルを挿入しオートフィルタのセル範囲を拡張

オートフィルターのドロップダウン矢印にマウスオーバーした際の表示から、絞り込み条件が適用されたままの状態であることがわかります。
ただし、まだ絞り込み条件の再適用を実行していないため、値が空白である挿入したセルが表示されています。
また、行番号の青字から、対象のオートフィルタのセル範囲が拡張されていることがわかります。

3.データの差し替え

拡張されたセル範囲に編集後データを貼り付け、次に編集前データのセルを削除し対象のオートフィルタのセル範囲を縮小させます。

f:id:e0m0jelly:20210719233151p:plain — 図05_データの差し替え

ここで、編集前データのセルの削除ですが、表示されているセルだけではなく絞り込み条件によって非表示となっているセルも削除し、対象のオートフィルタのセル範囲を縮小させていることに注意してください。

4.絞り込み条件の再適用

最後に、消えないように保持しておいた絞り込み条件の再適用を実行します。

f:id:e0m0jelly:20210719233807p:plain — 図06_絞り込み条件の再適用

想定通り、事前に設定されていた絞り込み条件「2021年 or 2020年6月 or 2019年6月1日」に該当するデータのみに絞り込むことができました。

実装

今回実装したコードは以下の通りです。

'【引数】
'targetAutoFilter : 絞り込み条件の保持と再適用を行う対象のAutoFilterオブジェクト
'afterEditDataRange : 編集後データが用意されているセル範囲のRangeオブジェクト（1.編集後データの用意）
Private Function changeDataAndReapplyFilter(targetAutoFilter As AutoFilter, afterEditDataRange As Range)
    Dim beforeEditDataCount As Long '編集前データの個数
    Dim afterEditDataCount As Long '編集後データの個数
    Dim i As Long 'ループ処理用の整数変数
    
    'ローカル変数の初期化
    beforeEditDataCount = targetAutoFilter.Range.Rows.Count - 1
    afterEditDataCount = afterEditDataRange.Rows.Count
    
    '編集後データの個数分の行挿入（2.対象のオートフィルタのセル範囲拡張）
    For i = 1 To afterEditDataCount
        targetAutoFilter.Range.Cells(2, 1).EntireRow.Insert
    Next
        
    '編集後データを貼り付け（3.データの差し替え）
    afterEditDataRange.Copy targetAutoFilter.Range.Cells(2, 1)
    
    '編集前データの行削除（3.データの差し替え）
    For i = 1 To beforeEditDataCount
        targetAutoFilter.Range.Cells(1 + afterEditDataCount + 1, 1).EntireRow.Delete
    Next
    
    '4.絞り込み条件の再適用
    targetAutoFilter.ApplyFilter
    
End Function

なお、お察しの通り編集前データや編集後データが0個の場合などの例外は考慮できていないので、必要に応じて組み込んでください。

補足

ActiveSheet.AutoFilterが返すオブジェクトが、状況によってWorksheet.AutoFilterが返る場合とActiveCell.ListObject.AutoFilterが返る場合があるそうです。
以下の記事で紹介されていました。
www.excel-chunchun.com もしかするとこれが原因で悩まされることがあるかもしれません。

http://officetanaka.net/excel/vba/tips/tips129.htm ↩

たのしいみかんゼリーのブログ

VBAのTipsを発信しています。