Sub SpecialCells01()
Dim A As Integer
On Error Resume Next 'エラー発生しても続行
A = Range("B2:B11").SpecialCells(xlCellTypeBlanks).Count 'B2~B11に未記入(空白)セルをカウントします。
If A < 10 Then
MsgBox "アンケートの記入漏れは、" & A & "件です"
Else
MsgBox "全てのアンケートが記入されています。"
End If
End Sub
Sub SpecialCells02()
Dim A, B, C As Integer
On Error Resume Next 'エラー発生しても続行
A = Range("A3:J14").SpecialCells(xlCellTypeConstants, xlNumbers).Count '定数(数値)のデータ件数 (青セル)
B = Range("A3:J14").SpecialCells(xlCellTypeConstants, xlTextValues).Count '定数(文字)のデータ件数 (赤セル)
C = Range("A3:J14").SpecialCells(xlCellTypeFormulas).Count '数式のデータ件数 (黄色セル)
MsgBox "定数(数値)のデータ件数は、" & A & "件" & vbCrLf & "定数(文字)のデータ件数は、" & B & "件" _
& vbCrLf & "数式のデータ件数は、" & C & "件"
End Sub
Sub SpecialCells03()
Dim Ans As Integer
Ans = MsgBox("入力されている数値を削除しますか?", vbYesNo + vbQuestion, "確認")
If Ans = vbYes Then 'Yesの場合は、実行します。
On Error Resume Next 'エラー発生しても続行
Range("A3:J14").SpecialCells(xlCellTypeConstants, xlNumbers).ClearContents '数値の入力されているセルを削除します。
MsgBox "数値が入力されているセルをクリアしました。"
Else
MsgBox "処理を中断します"
End If
End Sub