AdvancedFilterメソッドでデータを抽出する

　「偉いさんのスケジュールを蓄積して、予定表を出力するマクロ作ってくれや。もう引き受けてしもたから、絶対やれ！　分かったな！」というパワハラまがいの命令を受けて、なぜかスケジュール管理アプリみたいなのを自作する羽目になった悲惨な私です。

　そんなの、市販なりフリーなりの完成品使えばいいじゃん……。

　とはいえ、上司が引き受けてきてしまった以上、アホらしいと思いつつもやってしまう私……。なんてお人好しのバカなでしょう。。。

　ま、それはさておき、悪戦苦闘して作っていくなかで、AdvancedFilterメソッドというものに出会い、「なにこれ便利！」と思ったので、忘れないうちにブログに書いておこうと思ったのですよ。

　まずは、Bookの構成から。「予定マスタ」には、こんな具合にどんどん予定が蓄積されていく。一度登録した予定には全てIDを割り当て、削除した場合もシート上からは消してしまわず、Ｊ列の「IsDeleted」欄に「1」を書き込むことで「削除された」という状態を表現している。
　人物とか場所は、それぞれ「人物マスタ」、「場所マスタ」というシートで管理し、この「予定マスタ」にはそれぞれのID番号だけを登録するようにしている。

　これは、「予定抽出」シート。AdvancedFilterメソッドを実行すると、ここに抽出されたデータが貼り付けられる。当然、実行前なので何も書き込まれていない。

　

　「予定抽出」シートには、抽出条件を指定するための表を作ってある。下の画像のL1:O2がそれ。「CriteriaRange1」と名前を付けている。

　「人物マスタ」シートと、

「場所マスタ」シートは、それぞれこんな感じ。

　で、条件抽出をするためのマクロがこちら。

Sub extractByAdvancedFilter(ByRef RangeOfCriteria As Range, _
                            ByVal CriteriaDate As Date, _
                            ByVal CriteriaPerson As String, _
                            ByVal CriteriaEnableToOpen As String, _
                            ByVal CriteriaIsDeleted As String)
On Error Resume Next                        '……(1)
  Err.Clear
  Dim mstSh As Worksheet                    '……(2)
  Dim objSh As Worksheet
  With ThisWorkbook
    Set mstSh = .Worksheets("予定マスタ")
    Set objSh = .Worksheets("予定抽出")
  End With
  '抽出条件セット
  With RangeOfCriteria                      '……(3)
    .Cells(2, 1) = CriteriaDate
    .Cells(2, 2) = CriteriaPerson
    .Cells(2, 3) = CriteriaEnableToOpen
    .Cells(2, 4) = CriteriaIsDeleted
  End With
  'データ抽出
  objSh.Range("A1").CurrentRegion.ClearContents           '……(4)
  mstSh.Range("A1").CurrentRegion.AdvancedFilter _
                                    Action:=xlFilterCopy, _
                                    CriteriaRange:=RangeOfCriteria, _
                                    CopyToRange:=objSh.Range("A1:J1")
  '抽出データの並べ替え
  With objSh.Sort                             '……(5)
    .SortFields.Clear
    .SortFields.Add Key:=objSh.Range("C1"), _
                    SortOn:=xlSortOnValues, _
                    Order:=xlAscending, _
                    DataOption:=xlSortNormal  '……(6)
    .SortFields.Add Key:=objSh.Range("D1"), _
                    SortOn:=xlSortOnValues, _
                    Order:=xlAscending, _
                    DataOption:=xlSortNormal
    .SetRange objSh.Range("A1").CurrentRegion '……(7)
    .Header = xlYes                           '……(8)
    .MatchCase = False
    .Orientation = xlSortColumns
    .SortMethod = xlPinYin
    .Apply                                    '……(9)
  End With
'エラーキャッチ
  If Err.Number > 0 Then                      '……(10)
    MsgBox "AdvancedFilterメソッド実行時に、" & _
           Err.Number & "：" & Err.Description & _
           "というエラーが出たよ～ん♪"
    MsgBox "エラー番号を頼りに自力で解決してね！"
    MsgBox "    　＿＿＿＿＿＿＿＿_" & vbCrLf & _
           "　／　　　　　　　　  ＼ " & vbCrLf & _
           "／　／・＼　　／・＼　  　＼" & vbCrLf & _
           "|　　￣￣　　　￣　　 　　|　ち～んｗ" & vbCrLf & _
           "|　　　　（＿人＿）　　 　|" & vbCrLf & _
           "|　　　　　＼ 　   |   　    　 |" & vbCrLf & _
           "＼　　　　 　＼＿|　　   ／"
    MsgBox "このWorkbookを閉じます。"
    If Excel.Application.Workbooks.Count <> 1 Then  '……(11)
      ThisWorkbook.Close True
    Else
      Excel.Application.Quit
    End If
  End If
On Error GoTo 0
End Sub

　プロシージャ名のところを見れば分かるように、他のプロシージャから呼び出して実行するものにしている。

　第１引数RangeOfCriteriaには、条件指定用のセル範囲を指定する。

　第２引数CriteriaDateには、抽出対象の日付、
　第３引数CriteriaPersonには、抽出対象の人物番号、
　第４引数CriteriaEnableToOpenには、公開可能かどうか（可能なら「1」）、
　第５引数CriteriaIsDeletedには、削除されているかどうか（削除されていたら「1」）をそれぞれ指定する。

(1)で、エラーが発生しても無視して処理を続けるようにしている。Err.Clearで一旦エラー情報をリセットしているので、この後(10)のところでErrオブジェクトのNumberプロパティが0を超えていたら、このプロシージャ内で何らかのエラーが発生したということが分かる仕掛け。

(2)で、「予定マスタ」シートと「予定抽出」シートをオブジェクト変数にセットしてしまう。

(3)で、抽出条件をセットしていく。Cellsプロパティを使うと、親オブジェクトであるRangeオブジェクト内のセルを相対的に指定できるから便利。
　この場合だと、たとえばRangeOfCriteria.Cells(2,2)と書くと、RangeOfCriteriaが指している「Ｌ１：Ｏ２」の２行目２列目、すなわちＭ２セルを指定することができる。
　　このやり方を用いて、それぞれのセルに抽出条件を書き込んでいる。
　　ちなみに、今回は抽出条件を横１行にしているが、横方向に並べるとAND条件、タテ方向に並べるとOR条件になるので、工夫次第で非常に柔軟な条件指定ができそう。

(4)で、一旦「条件抽出」シートを全てクリアしている。これを忘れると大変（どう大変なのかは自分で考えよう）。

(5)で抽出したデータを並べ替えている。予定は順不同でどんどん積み上げられていくから、何もしないと同日の予定が順不同に並ぶという不親切なことになるのでこうした。ちなみに、旧来のRangeオブジェクトのSortメソッドによる並べ替えではなく、Sortオブジェクトによる並べ替えに挑戦してみた。
　一旦並べ替え条件をクリアした後、(6)で並べ替え条件を追加し、(7)で並べ替え対象の範囲をセット、(8)で並べ替えの方法をセットし、ようやく(9)で並べ替え実行、という流れになっている。
　　一見、めんどくさそうな処理だけど、慣れてしまえば合理的なやり方に思えてくるかも（私はまだ慣れていませんが）。

(10)は、ここまでの過程でエラーが生じていた場合の処理。エラーが生じていると、ErrオブジェクトのNumberプロパティに何らかの数字が入るので、エラーが発生していた場合は条件式がTrueになって、Then以下の処理に移る、という仕掛け。

　エラーが生じていた場合の処理は、ちょっとむかつくものにしておいたｗ

　では、さっそく実行してみよう。今回のマクロは、他のプロシージャから引数を渡して実行する形をとるので、実行用のコードを示す。

Sub test()
  Call extractByAdvancedFilter(Range("CriteriaRange1"), _
                               "2017/2/6", _
                               "1", _
                               "1", _
                               "<>1")
End Sub

　引数が５つもあるのでちょっとうっとうしいけど、まとめると、
条件指定用のセル範囲は「CriteriaRange1」って所で、抽出条件は、日付が2016/2/6、人物の番号は1、公開可能で、削除されていないデータを抽出せい！
ということになる。

　このTestプロシージャを実行すると、

　まず、条件欄にこのように書き込まれ、

ほれ、この通り、指定した条件に合致するデータが抽出されている。

　「Advanced」というだけあって、勉強したらもっと柔軟な処理ができそう。ある程度マクロが作れるようになったら、Excel本体の機能を熟知しないといけませんな。