一問一答の一歩

商法技術者試験に合格してそのことを生かしてPG(プログラマー)やSE(システムエンジニア)として働くとなると必ず管理職の人に成果物を確認してもらう機会は出てくる。この管理職の人に成果物を見せることを「マイルストーン」と呼ばれるのだが、見られる観点は多岐に渡る。

管理尺に見られるレビューの観点として、一つに文章の体裁や句読点、フォントの違いなどもよく見られるのだが、膨大な書類の中びフォントが全てシート内で一致していることを確認すると日が暮れる上にだるいのでExcelのVBAマクロ(ツール)を使って一気に確認できるようにした。

プログラムは下記の通りです。

Sub Check_differentFont()
'---------------------------------
'概要:シート内を比較し、違っているフォントがあったらセル番号を出力する
'機能名:Check_differentFont
'引数:なし
'戻り値:なし
'備考:
'--------------------------------

	Dim mysheet As Worksheet
	Dim optional_sheet As Worksheet
	Dim fontname As String
	Dim myBook_name As String
	Dim mysheet_name As String
	Dim row_number As Integer
	Dim result_row As Integer
	Dim result_sheetname_column As Integer
	Dim resultrow_column As Integer
	Dim resultcolumn_column As Integer
Dim fontname_column As Integer
	Dim column_number As Integer
	Dim last_row As Integer
	Dim last_column As Integer
	Dim replace_flg As Integer

	Set optional_sheet = Worksheets("Sheet1")
	'4Dのセルを参照(4Dにブック名を入力する)
	myBook_name=optional_sheet.Cells(4,4).Value
	replace_flg = optional_sheet.Cells(5,4).Value
	result_row = 11
	result_sheetname_column = 4
	resultrow_column = 5
	resultcolumn_column = 6
fontname_column = 7
	'全シートループ
	For Each mysheet In Workbooks(myBook_name).Worksheets

		'フォント名の初期化
		fontname = ""
		
		'変更前シートの最初から最後の行、列の数まで繰り返す
		'最終列を取得(とりあえず1行目から50行目までを検索)
		last_column = 0
		For row_number = 1 TO 50
			If last_column < mysheet.Cells(row_number,Columns.Count).End(xlToLeft).Column Then
				last_column = mysheet.Cells(row_number,Columns.Count).End(xlToLeft).Column
			End If
		Next row_number
		'最終行を取得(とりあえず1列目から30列目までを検索)
		last_row = 0
		For column_number = 1 TO 30
			If last_row < mysheet.Cells(Rows.Count,column_number).End(xlup).Row Then
	
				last_row = mysheet.Cells(Rows.Count,column_number).End(xlup).Row
			End If
		Next column_number

		'MsgBox "last_row：" & last_row & vbLf & "last_column：" & last_column 
		
		For row_number=1 To last_row
			For column_number =1 to last_column
				'セルが空白でない場合、最初のフォントを取得
				If mysheet.Cells(row_number,column_number).Value <> "" Then
					If fontname = "" Then
						fontname=mysheet.Cells( row_number , column_number).Font.Name
					ElseIf mysheet.Cells( row_number , column_number).Font.Name <> fontname Then
						'最初のフォントと違うセルがある場合、シート名、行、列を取得
						optional_sheet.Cells(result_row,result_sheetname_column).Value = mysheet.Name
						optional_sheet.Cells(result_row,resultrow_column).Value = row_number
						optional_sheet.Cells(result_row,resultcolumn_column).Value = column_number
optional_sheet.Cells(result_row,fontname_column).Value = mysheet.Cells( row_number , column_number).Font.Name


						
						result_row = result_row + 1
						If replace_flg <> 0 Then
							'修正も行う場合、修正も行う
							mysheet.Cells(row_number,column_number).Font.Name = fontname
						End If
					End If
				End If
			Next column_number
		Next row_number
	
	Next mySheet

End Sub