一問一答の一歩

システムの開発中に複数行にまたがるログデ一タを取得したいという状況が出てきた。

この時に指定文字を含む開始行から指定文字を含む終了行を探し、その間の行をまとめて出力するエクセルVBAマクロを作成したので共有する。

ソースコードは下記の通り

Sub Between_logdata()
'----------------------------------------------
'概要: ログファイルから開始となる文字から終了となる文字までを抽出する
'機能名: Between_logdata
'引数: なし
'戻り値: なし
'備考:ログファイルから開始となる文字から終了となる文字までを抽出する
'----------------------------------------------
	
	'ワークシート関連の変数
	Dim inputSheet As Worksheet
	Dim outputSheet As WorkSheet
	Dim optional_sheet As Worksheet
	Dim inputbook_name As String
	Dim outputbook_name As String
	Dim inputSheet_name As String
	Dim outputSheet_name As String
	Dim write_lastrow_flg As Integer
	'入力データから転記開始をする文字列を取得
	Dim start_str As String
	Dim start_row As Long
	'入力データから転記終了する文字列を取得
	Dim end_str As String
	Dim end_row As Integer
	'ワークシートの最終行と最終列の取得
	Dim last_row As Long
	Dim last_column As Integer
	
	Set optional_sheet = Worksheets("Sheet1")
	'3Dのセルを参照(3Dにシート名を入力する)
	inputbook_name = optional_sheet.Cells(5,5).Value
	'4Dのセルを参照(4Dにシート名を入力する)
	inputsheet_name = optional_sheet.Cells(6,5).Value
	'6Dのセルを参照(6Dにシート名を入力する)
	outputbook_name = optional_sheet.Cells(8,5).Value
	'7Dのセルを参照(7Dにシート名を入力する)
	outputsheet_name = optional_sheet.Cells(9,5).Value
	
	write_lastrow_flg = optional_sheet.Cells(9,5).Value
	
	If(inputbook_name<>"") Then
		Set inputsheet = Workbooks(inputbook_name).Worksheets(inputsheet_name)
	Else
		Set inputsheet = ThisWorkbook.Worksheets(inputsheet_name)
	End If
	If(outputbook_name<>"") Then
		Set outputsheet = Workbooks(outputbook_name).Worksheets(outputsheet_name)
	Else
		Set outputsheet = ThisWorkbook.Worksheets(outputsheet_name)
	End If
	'項目の検索対象文字列データ(最初の文字を記載すること)
	' 8Dのセルを参照( 8Dに項目1の検索対象文字列を入力する)
	start_str = optional_sheet.Cells(3,5).Value
	'10Dのセルを参照(10Dに項目2の検索対象文字列を入力する)
	end_str = optional_sheet.Cells(4,5).Value
	'転記対象の列データ
	' 5Dのセルを参照( 5Dに読込対象文字列を入力する)
	inputcolumn = optional_sheet.Cells(7,5).Value
	' 9Dのセルを参照( 9Dに項目1の検索対象文字列を入力する)
	outputcolumn = optional_sheet.Cells(10,5).Value
	
	outputrow = 1
	
	'最終行を取得(とりあえず1行目から30行目までを検索)
			last_row = 0
			For column_number = 1 TO 30
				If last_row < inputSheet.Cells(Rows.Count,column_number).End(xlup).Row Then
					last_row = inputSheet.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
		'はじめとなる文字列を検索
		If InStr(inputSheet.Cells(row_number, inputcolumn).Value, start_str) <> 0 Then
			
			'見つかったら、はじめの文字のある行を開始地点として終わりとなる文字列を検索
			start_row = row_number
			For row_number_2 = start_row TO last_row
				
				If Dim write_lastrow_flg = 1 Then
					'セルを転記する
					outputsheet.Cells(outputrow, outputcolumn).Value = inputSheet.Cells(row_number_2, inputcolumn).Value
				End If
				If InStr(inputSheet.Cells(row_number_2, inputcolumn).Value, end_str) <> 0 And row_number_2 <> start_row Then
					row_number = row_number_2 - 1
					outputrow = outputrow + 3
					GoTo BREAKPOINTS
				Else
					outputrow = outputrow + 1
				End If
				If Dim write_lastrow_flg <> 1 Then
					'セルを転記する
					outputsheet.Cells(outputrow, outputcolumn).Value = inputSheet.Cells(row_number_2, inputcolumn).Value
				End If
			Next row_number_2
			BREAKPOINTS:
		End If
	Next row_number
End Sub