一問一答の一歩

仕事でエクセルを用いて文章を作成していると、句読点が抜けていたり、半角や全角の誤り、間違えてコロンやピリオドを打ってしまっていることがあるはずである。

そのため、後から入力した値をチェック(エディットバリデーションチェック)を行うことはミスを減らすためにはとても重要なことであるといえます。

句読点が抜けている文章を探して、該当のセルを表示するVBAのマクロについては下記のサイトにも詳しく書かれています。

VBAで末尾に句読点がない文章を探す ｜ Excel作業をVBAで効率化

確かに上記のサイトは句読点の使用についても丁寧に解説してくれた非常に分かりやすいサイトです。

しかし、表のような形式になっている書面では、上記サイトのように全てのセルのチェックを行って背景を染めると不都合になる状況もあり、自分が指定した行と列のみをチェックできる方が使用しやすい状況もあるように思えたので、メモも兼ねて作成したコードを共有します。

以下のエクセルシートのフォームを作って実行することを前提とします。

Sub Check_kutouten()
'----------------------------------------------
'概要:エクセルシート内の句読点の抜けているセル、句読点が,(コンマ).(ピリオド)になっているセルを判定してセルを黄色く染める
'機能名: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)
	'シートのB2のセルに記載したブック名を取得
	book_name=optional_sheet.Cells(2,2).Value
	'シートのB3のセルに記載したシート名を取得
	sheet_name=optional_sheet.Cells(3,2).Value
	Set ws=Workbooks(book_name).Worksheets(sheet_name)
	'シートのB4のセルに記載した開始行番号を取得
	first_row_number = optional_sheet.Cells(4,2).Value
	'シートのB5のセルに記載した終了行番号を取得
	last_row_number = optional_sheet.Cells(5,2).Value
	row_count = last_row_number - first_row_number
	'処理する列数を取得
	column_count = optional_sheet.Cells(6,2).Value
	If row_count > 0 And column_count > 0 Then
		'ワークシートの入力セル範囲のセルを1つずつループ
		For column_number = 1 to column_count
			'シートのB6より下のセルに記載した1つ目の列を処理対象にする
			column_hosei = optional_sheet.Cells(6+column_number,2).Value
			If column_hosei = 0 Then
				'B7より下のセルに列番号が入力されていなかったら、その列は処理しない
				GoTo CONTINUE
			End If
			'指定した行から最終行まで繰り返す
			For row_number=1 to row_count
				Set cell = ws.Cells(first_row_number+row_number,column_hosei)
				'MsgBox column_hosei
				'MsgBox row_number
				'確認対象のセルが未入力の場合(空白は除去して判定)
				If cell.Value="" THEN
					'次のセルの処理を行う
					GoTo CONTINUE
				End If
				'確認対象が数式の場合(空白は除去して判定)
				If cell.HasFormula THEN
					'次のセルの処理を行う
					GoTo CONTINUE
				End If
	
				'----------------------以降は確認対象のセルが入力されている場合------------------------
				'末尾文字を取得
				last_spell=Right(ws.Cells(first_row_number+row_number,column_hosei),1)

				'MsgBox last_spell
				'末尾が句読点でない場合
				If(last_spell<>"。")And(last_spell<>"、") Then
				'セルの背景色を黄色に設定
					Cell.Interior.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 Then
					'セルの背景色を黄色に設定
					Cell.Interior.Color=RGB(255,255,0)

				End If
				CONTINUE:
			Next
		Next
	End If
End Sub