エクセルVBA100本ノック。９本目：フィルターコピー

この記事から得るもの

Collectionオブジェクトの特徴。
AutoFilterの使い方。
Worksheetが存在するかチェックする処理。
Set 変数 ＝ Worksheets（””）のスマートな書き方。

目次
　 １　今回のお題
　 ２　今回のお題の意図
　 ３　回答
　 ４　Worksheet追加時のスマートな書き方　

１　今回のお題

「成績表」シートに5教科の成績とG列に合否判定があります。
「合格者」シートを新規作成し、合格者の氏名だけをA列に列挙してください。
※点数は非公開なので「合格者」シートには間違っても出力しないでください。
※何度でも実行できるようにしてください。

excel-ubara.com

２　今回のお題の意図

何度でも実行できるようにしてください。ということは、Sheetが残ったままだと新規Sheetを作成処理を書いている場合、すでに同じSheetがエラーとなって何度も実行することができません。そこに留意することと理解しました。

３　回答

私の最初の回答

Sub ノック9本目_1()

Dim Ws As Worksheet: Set Ws = Worksheets("成績表")
Dim SuccessfulCandidate As Collection: Set SuccessfulCandidate = New Collection

'合格者をコレクションに入れる
For SeachSuccessfulCandidate = 2 To Ws.Cells(Rows.Count, 1).End(xlUp).Row
    If Ws.Cells(SeachSuccessfulCandidate, 7) = "合格" Then
        SuccessfulCandidate.Add Ws.Cells(SeachSuccessfulCandidate, 1).Value
    End If
Next

'合格者Sheetが存在すれば削除する。
For Each SeachWs In Worksheets
    SheetName = SeachWs.Name
    
    If SheetName = "合格者" Then
        Application.DisplayAlerts = False
        SeachWs.Delete
        Application.DisplayAlerts = True
        Exit For
    End If
Next

'合格者Sheetを作る
Worksheets.Add.Name = "合格者"
Dim Ws2 As Worksheet: Set Ws2 = Worksheets("合格者")

'合格者を書込
i = 0

For Each WriteSuccessfulCandidate In SuccessfulCandidate
    i = i + 1
    Ws2.Range("A" & i) = SuccessfulCandidate.Item(i)
Next

End Sub

処理の流れはコメントの通りです。
１　合格者をコレクションに入れる
２　合格者Sheetが存在すれば削除する。
３　合格者Sheetを作る
４　合格者を書込

この流れでプロシージャを作成すれば、何度でも実行できるという要件に沿っていますね。

しかし、お題「フィルターコピー」とありますが、フィルターコピーやってねぇ～(;^ω^)。ということに気づきました。
また、コレクションに合格者を加えているので、同姓同名がいた場合対応できません。なぜなら、コレクションには重複したデータを入れることができないからです。
なので、フィルターコピーを使って上手に記述されている方のコードを見てみましょう。

吉田拳先生の回答

Sub 吉田拳先生の回答()

Application.DisplayAlerts = False

Dim i As Long, ws As Worksheet

For i = Sheets.Count To 1 Step -1
    If Sheets(i).Name = "合格者" Then: Sheets(i).Delete
Next

Set ws = Sheets.Add: ws.Name = "合格者"

With Sheets("成績表")
    .Range("A1").AutoFilter field:=7, Criteria1:="合格"
    .Columns(1).Copy ws.Range("A1")
    .Range("A1").AutoFilter   'フィルタの解除
End With

End Sub

オートフィルタをＶＢＡで書いたことが無い私でも、こんな簡単に書けるのか～！と、わかりやすさに驚きです。
合格者Sheetが存在するかどうかの処理も、動きに無駄がないというかスマートな書き方ですね。

４　Worksheet追加時のスマートな書き方

１　Worksheetを加える。
２　Sheetに名前をつける。
３　WorksheetObuject変数に格納する（Set）。

この書き方で一番スマートなのはどれかなのか。

私の書き方

Worksheets.Add.Name = "合格者"
Dim Ws2 As Worksheet: Set Ws2 = Worksheets("合格者")

吉田拳先生の書き方

Set ws = Sheets.Add: ws.Name = "合格者"

神髄先生の書き方

Set wsOut = Worksheets.Add(After:=wsIn)
wsOut.Name = "合格者"

やはり、１行で書いているスマートさから、吉田拳先生に１票ですね。
神髄先生のも”：”で１行にしてやれば吉田先生と同じですね。

では、このへんで(^^)/~~~