指定した列の句読点チェックを行い、抜けているセルに色を付けるマクロ
仕事でエクセルを用いて文章を作成していると、句読点が抜けていたり、半角や全角の誤り、間違えてコロンやピリオドを打ってしまっていることがあるはずである。
そのため、後から入力した値をチェック(エディットバリデーションチェック)を行うことはミスを減らすためにはとても重要なことであるといえます。
句読点が抜けている文章を探して、該当のセルを表示するVBAのマクロについては下記のサイトにも詳しく書かれています。
VBAで末尾に句読点がない文章を探す | Excel作業をVBAで効率化
確かに上記のサイトは句読点の使用についても丁寧に解説してくれた非常に分かりやすいサイトです。
しかし、表のような形式になっている書面では、上記サイトのように全てのセルのチェックを行って背景を染めると不都合になる状況もあり、自分が指定した行と列のみをチェックできる方が使用しやすい状況もあるように思えたので、メモも兼ねて作成したコードを共有します。
STEP1:入力フォーム
以下のエクセルシートのフォームを作って実行することを前提とします。
STEP2:ソースコード
Sub Check_kutouten()
'---------------------------------
'概要:エクセルの指定した場所の句読点が抜けていたり,(コンマ).(ピリオド)になっているセルを判定してセルを黄色く染める。
'--------------------------------
Dim Optional_Sheet As Worksheet
Dim ws As Worksheet
Dim cell As Range
Dim last_spell As String
Dim row_number As Long
Dim first_row_number As Long
Dim last_row_number AS Long
Dim row_count AS Long
Dim column_count AS Long
Dim column_number As Long
Dim column_hosei As Long
Dim book_name AS String
Dim sheet_name As String
Set Optional_sheet =Worksheets(1)
'シートのB1のセルに記載したブック名を取得
book_name=optional_sheet.Cells(1,2).Value
'シートのB2のセルに記載したシート名を取得
sheet_name=optional_sheet.Cells(2,2).Value
ws=Workbooks("book_name").Worksheets("sheet_name")
'シートのB3のセルに記載した開始行番号を取得
first_row_number = optional_sheet.Cells(3,2).Value
'シートのB4のセルに記載した終了行番号を取得
first_row_number = optional_sheet.Cells(4,2).Value
row_count = last_row_number - first_row_number
'処理する列数を取得
column_count = optional_sheet.Cells(4,2).Value
If row_count > 0 And column_count > 0 Then
'ワークシートの入力セル範囲のセルを1つずつループ
For colum_number = 1 to column_count
'シートのB5より下のセルに記載した1つ目の列を処理対象にする
column_hosei = optional_sheet.Cells(4+column_count,2).Value
If column_hosei = ""
'B5より下のセルに列番号が入力されていなかったら、その列は処理しない
GoTo CONTINUE
End If
'指定した行から最終行まで繰り返す
For row_number=1 row_count
Set cell = ws.Cells(first_row_number+row_number,column_number+column_hosei)
'確認対象のセルが未入力の場合(空白は除去して判定)
If cell.Value="" THEN
'次のセルの処理を行う
GoTo CONTINUE
End If
'確認対象が数式の場合(空白は除去して判定)
If cell.HasFormula THEN
'次のセルの処理を行う
GoTo CONTINUE
'----------------------以降は確認対象のセルが入力されている場合------------------------
'末尾文字を取得
last_spell=Right(ws.Cells(first_row_number+row_number,column_number+column_hosei),1)
'末尾が句読点でない場合
If(last_spell<>"。")And(last_spell<>"、")
'セルの背景色を黄色に設定
Cell.Interrior.Color=RGB(255,255.0)
End If
'コンマ、ピリオドが含まれている場合
If Instr(cell.Value,",")<>0 Or Instr(cell.Value,".")<>0 Or Instr(cell.Value,",")<>0 Or Instr(cell.Value,".")<>0
'セルの背景色を黄色に設定
Cell.Interrior.Color=RGB(255,255.0)
End If
CONTINUE:
Next
Next
End If
End Sub