一問一答の一歩

表が複数ある場合、一つの表の項目に対応する値を他の表から引っ張ってくるなんていうことがときどき起こったりする。

これは量が多くなると、かなりの手間となり、効率化による影響が大きい部分である。

なお、効率化の方法には2 つの方法が考えられる。

• ・関数を作成する
• ・マクロを作成する

今回はマクロを作成する方法を紹介する予定であり、マクロを用いることによるメリットは以下の通りである。

• ・2つの表の並び方が、違っていても、対応しやすい
• ・ファイルの位置が変わったとしても影響が小さい

実行のための設定を行うためのエクセルシ－トは以下のようなものを前提としており、ボタンを押すことで実行できるようにしています。

また、書換の対象となる表は以下のようなものを想定しており、項目が横に並んでいるものを想定しています。

VBAのソ－スコードについては以下の通りです。

Sub Copy_value

'----------------------------------------------
'概要:2つのエクセルシートの該当行を比較し、一致している項目の値を書き写す
'機能名:Copy_value
'引数:なし
'戻り値:なし
'備考:
'----------------------------------------------

	Dim readsheet As Worksheet
	Dim writesheet As Worksheet
	Dim optional_sheet As Worksheet
	Dim readbook_name As String
	Dim writebook_name As String
	Dim readbook_kakutyoshi As String
	Dim writebook_kakutyoshi As String
	Dim readsheet_name As String
	Dim writesheet_name As String
	Dim readsheet_index_column As Integer
	Dim writesheet_index_column As Integer
	Dim readsheet_contents_column As Integer
	Dim writesheet_contents_column As Integer
	Dim readsheet_start_row As Integer
	Dim writesheet_start_row As Integer
	Dim readsheet_row_number As Integer
	Dim writesheet_row_number As Integer
	
	Set optional_sheet =  Worksheets("シート名")
	'4Dのセルに入力した参照元ブック名を参照する
	readbook_name = optional_sheet.Cells(4,4).Value
	'4Eのセルに入力した参照元ブック名を参照する
	writebook_name = optional_sheet.Cells(4,5).Value
	If optional_sheet.Cells(5,4).Value = "" Then
	'拡張子を自動でxlsxに設定
	readbook_kakutyoshi = ".xlsx"
	Else 
	'5Dのセルに入力した拡張子を参照する
	readbook_kakutyoshi = optional_sheet.Cells(5,4).Value
	End If
	If optional_sheet.Cells(5,4).Value = "" Then
	'拡張子を自動でxlsxに設定
	writebook_kakutyoshi = ".xlsx"
	Else 
	'5Eのセルに入力した拡張子を参照する
	writebook_kakutyoshi = optional_sheet.Cells(5,5).Value
	End If
	'6Dのセルに入力した記載先シート名を参照する
	readsheet_name = optional_sheet.Cells(6,4).Value
	'6Eのセルに入力した記載先シート名を参照する
	writesheet_name = optional_sheet.Cells(6,5).Value
	'7Dのセルに入力したインデックス列番号を参照する
	readsheet_index_column = optional_sheet.Cells(7,4).Value
	'7Eのセルに入力したインデックス列番号を参照する
	writesheet_index_column = optional_sheet.Cells(7,5).Value
	'8Dのセルに入力した転記列番号を参照する
	readsheet_contents_column = optional_sheet.Cells(8,4).Value
	'8Eのセルに入力した転記列番号を参照する
	writesheet_contents_column = optional_sheet.Cells(8,5).Value
	'9Dのセルに入力した転記開始行番号を参照する
	readsheet_start_row = optional_sheet.Cells(9,4).Value
	'9Eのセルに入力した転記開始行番号を参照する
	writesheet_start_row = optional_sheet.Cells(9,5).Value

	Set readsheet=Workbooks(readbook_name & readbook_kakutyoshi).Worksheets(readsheet_name)
	Set writesheet=Workbooks(writebook_name & writebook_kakutyoshi).Worksheets(writesheet_name)
	
	For readsheet_row_number = readsheet_start_row TO readsheet.Cells(Rows.Count,readsheet_index_column).End(xlup).Row
		For writesheet_row_number = writesheet_start_row TO writesheet.Cells(Rows.Count,writesheet_index_column).End(xlup).Row
			If writesheet.Cells(writesheet_row_number , writesheet_index_column).Value = readsheet.Cells(readsheet_row_number , readsheet_index_column).Value THEN
				writesheet.Cells(writesheet_row_number , writesheet_contents_column ).Value =readsheet.Cells(readsheet_row_number , readsheet_contents_column).Value
				'該当インデックスの検索を終了する。
				Exit For
			END IF
		Next writesheet_row_number
	Next readsheet_row_number
End Sub