VBA100本ノック9本目：フィルターコピー

excel-ubara.com

出題内容

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

自分の解答

Sub vba9()

　Dim trgtShName As String
　Dim flg As Boolean　
　Dim ws As Worksheet

　trgtShName = "合格者"

　'対象シートがあった場合True
　For Each ws In ThisWorkbook.Worksheets
　　If ws.Name = trgtShName Then
　　　flg = True

　　　Sheets(trgtShName).Cells.Clear　'①
　　　Exit For
　　End If
　Next

　'フラグがFalseだった場合シートを作成
　If flg = False Then
　　Worksheets.Add.Name = trgtShName
　End If

　Sheets("成績表").AutoFilterMode = False　'②

　With Sheets("成績表").Range("A1")

　　.AutoFilter field:=7, Criteria1:="合格"
　　.CurrentRegion.Offset(1, 0).Resize(, 1).Copy
　　Sheets("合格者").Range("A1").PasteSpecial xlPasteValues
　　Application.CutCopyMode = False
　　.AutoFilter

　End With

End Sub

解答確認後二か所修正。

①元データが残っている可能性がある為、データクリアをしてから作業を始める。

②作業前にフィルター解除。

模範解答

Sub VBA100_09_01()
　Dim wsIn As Worksheet
　Dim wsOut As Worksheet

　On Error Resume Next
　Application.DisplayAlerts = False
　Worksheets("合格者").Delete
　Application.DisplayAlerts = True
　On Error GoTo 0

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

　wsIn.AutoFilterMode = False
　With wsIn.Range("A1").CurrentRegion
　　.AutoFilter Field:=7, Criteria1:="合格"
　　.Columns(1).Copy wsOut.Range("A1")
　End With
　wsIn.AutoFilterMode = False
End Sub

 合格者シートがあるか確認するよりも、合格者シートを削除して作成し直す方がわかりやすそう。

列コピーColumns(1)で問題ない。