出題内容
「成績表」シートに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 = TrueSheets(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 WithEnd 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)で問題ない。