一問一答の一歩

デ－タの整理は、一つ一つの確認するべきことが多い上に、大抵目で見切れないほど大量のものが含まれている。デ－タのフォーマットを統一した上で、デ－タに抜け漏れがないかを確認することはデ－タの専門用語ではデ－タクレンジングと呼ばれているが、今回はそのExcelでデ－タ整理の助けとなるデ－タ番号を振るためのVBAマクロによるツールについて情報共有する。

下記のように、セルごとにリストの番号が着いているが、一部セルが抜けており、そこに(番号)－2や(番号)－3のように節番号をつけるプログラムである

(実施前)

プログラムを実施すると、以下の図ようになります

(実施後)

Sub write_list_number()
'----------------------------------------------
'概要:抜けている番号に小連番を付ける
'機能名:set_list_number()
'引数:なし
'戻り値:なし
'備考:
'----------------------------------------------

	Dim ws As Worksheet
	Dim cell As Range
	Dim last_spell As String
	Dim row_number As Long
	Dim column_number As Long
	Dim list_number As Long
	Dim book_name As String
	Dim sheet_name As String
	Dim parent_number As Long
	
	Set optional_sheet = Worksheets("Sheet1")
	'ブック名を取得'(1Bにブック名を入力する)
	book_name = optional_sheet.Cells(1,2).Value
	'シート名を取得'(2Bにシート名を入力する)
	sheet_name = optional_sheet.Cells(2,2).Value
	'列番号を取得
	column_number = optional_sheet.Cells(3,2).Value
	'開始行番号を取得
	row_start_number = optional_sheet.Cells(4,2).Value
	'終了行番号を取得
	row_end_number = optional_sheet.Cells(5,2).Value
	Set ws = Workbooks(book_name).Worksheets(sheet_name)
	list_number = 2
	'//ワークシートの入力セル範囲のセルを一つずつループ
	If row_start_number < row_end_number Then
		'8行目から最終行まで取り出す
		For row_number = row_start_number To row_end_number
			Set cell = ws.Cells(row_number,column_number)
			'//セルに未入力の場合(空白は除去して判定)
			If cell.Value = "" Then
				'もともとの番号を取得
				
				If list_number = 2 Then
					parent_number =ws.Cells(row_number - 1,column_number)
					ws.Cells(row_number - 1, column_number).Value = parent_number & "-1"
				End If
				'//セルに小連番を追加する
				cell.Value = parent_number & "-" & list_number
				list_number = list_number + 1
			Else 
				list_number = 2
			End If
			
		Next
	Else
		MsgBox "開始行は終了行よりも小さい数字を設定してください"
	End If
End Sub