EXCEL VBA

Excel-VBA ログファイルからの文字列を検索し値抽出

EXCEL VBA

こんにちは! 健史です。

汎用コンピュータが出力するメッセージデータやデータベースに独自構築したテーブルにプログラムが処理したメッセージから、処理開始時刻や件数など必要なメッセージだけを抽出したいこと、ありませんか。

汎用コンピュータが出力するメッセージは1日で何万行、何十万行、何百万行となるでしょう。

そうしたログファイルから、特定のメッセージを抽出する処理を作成してみました。

この記事は、以下の記事の姉妹版です。

Excel-VBA 実例 テキストの文字列を検索し値を抽出
テキストファイルの中から件数など特定の文字列を確認していることありませんか。しかも毎日とか定期的に複数の項目を。ファイルを開いて見つけるのは面倒です。テキストファイルから特定の文字列をExcelシートに抽出するプログラムを作成してみました。


尚この記事は、Excel-VBAを起動して貼り付ければ動作することを目指しています。

Excel-VBAの構造、起動方法、実行方法などを理解されていない方は、以下の記事を参照しながら一度やってみてから対応されることをお勧めします。

Excel-VBA 実例 この通りやれば動く、とにかく触ってみよう
こんにちは! 健史です。 パソコンをお使いの方の多くは、表計算ソフトExcelを利用されていると思います。 この記事は、Exceは知っているけれど ・Excel-VBAって何? ・Excel-VBAは取っ付きにくい! ・E...

実行中に発生したエラーの対処法は、上記記事の2.エラーが発生したときの対処法に記載しています。(この段落のリンクから直接遷移します)

スポンサーリンク

プログラムの概要

イメージ

1.入力
◇設定シート

以下のログファイルより、「ジョブ名・プログラム名・メッセージ」が一致するところの内容を抽出します。

◇ログファイル

2.出力

12行目以降は、エラーデータを設定しています。

仕様概要

1.設定シートの[入力ファイル]を読み込み、ワークシートに格納する
2.抽出データの[ジョブ名・プログラム名]をワークシートから検索する
3.上記2.で検索した行のメッセージから、さらに以下を検索処する
 1).検索パターンが"1"の場合、一致したメッセージの後の文字列をすべて抽出
 2).検索パターンが"2"の場合、一致したメッセージの後の"="の後の文字列を抽出

実際のものとは異なっていると思いますが、汎用コンピュータが出力するメッセージをイメージしてみました。

プログラムの作成と実行

実行までの手順

1.データ準備

1).検索対象となるデータ
検索対象の[logfile.txt]を作成しておきます。

JOBAP0010 JAP0010P 処理開始 2020/12/22 08:05
JOBAP0010 JAP0010P 受注ファイル入力 = 1500 商品ファイル検索エラー = 5 受注加工編集出力 = 1495
JOBAP0010 JAP0010P 処理終了 2020/12/22 08:06
JOB0020 JAP002010P 処理開始 2020/12/22 10:25
JOB0020 JAP002010P 売上ファイル入力 = 3000
JOB0020 JAP002010P 売上日付エラー = 15
JOB0020 JAP002010P 売上加工編集出力 = 2985
JOB0020 JAP002010P 処理終了 2020/12/22 10:26

①サクラエディタやTeraPadの場合
上記イメージの入力欄に記載した2つのデータをコピー&ペーストし、サクラエディタやTeraPadなどのエディタにて、文字コードを"SJIS"で保存します。

サクラエディタとTeraPadでは、右下(文字位置の行・桁を表示している行)の表示が"SJIS"になっていればそのまま保存します。

"UTF-8"など別の文字コードになっている場合は、以下で変更します。
・サクラエディタ
[ファイル(F)]-[名前を付けて保存(A)]で、ファイル名・ファイル種類の下の[文字コードセット(C)]に"SJIS"を選択

・TeraPad
[ファイル(F)]-[文字/改行コード指定保存(K)]で、[文字コード(J)]に"SHIFT-JIS"を選択

②メモ帳(notepad)の場合
保存するときに[文字コード(E)]を"ANSI"に変えて保存します。

これは、Windowsの[メモ帳(notepad)]の文字コード既定値が"UTF-8"なったための対応です。

参考記事:メモ帳の文字コード既定値がUTF-8に、Windows 10「May 2019 Update」

文字コードが"UTF-8"で保存されると、設定シートで指定した検索文字として検索できません。

[メモ帳(notepad)]にて"UTF-8"で保存した場合には再度開いて、[名前を付けて保存(A)]を選択し、[文字コード(E)]を"ANSI"にして保存します、「上書きしますか?」のメッセージで"はい(Y)"を選択して。

尚、当記事のプログラムを流用してコンピュータが出力したテキストファイルを検索できないことがあるかもしれませんが、そのときは文字コードを確認します。

実際にどうなるのかわかりませんが、その際は検索できる文字コードで出力してもらうように依頼するとか、できないなら変換する処理を加える必要があると思います。

2.Excelを起動
1).シート1(設定)に以下のデータを貼り付ける
ドラッグ&コピー後にExcelに貼り付けるとき、[形式を選択して貼り付ける]-[テキスト]で貼り付けます。(セル[A1]で[右クリック]、[形式を選択して貼り付ける]-[テキスト])

入力ファイル
G:\TEST10\logfile.txt

プログラムを実行する場合のフォルダ名やファイル名は、実際の環境に合わせて修正します。

2).シート2(抽出データ)に以下のデータを貼り付ける

ジョブ名	プログラム名	メッセージ	検索パターン	パターン1	パターン2
JOBAP0010	JAP0010P	処理開始	1		
JOBAP0010	JAP0010P	受注ファイル入力	2		
JOBAP0010	JAP0010P	商品ファイル検索エラー	2		
JOBAP0010	JAP0010P	受注加工編集出力	2		
JOBAP0010	JAP0010P	処理終了	1		
JOB0020	JAP002010P	処理開始	1		
JOB0020	JAP002010P	売上ファイル入力	2		
JOB0020	JAP002010P	売上加工編集出力	2		
JOB0020	JAP002010P	売上日付エラー	2		
JOB0020	JAP002010P	処理終了	1		
JOB0020	JAP002010P	処理終了	3		
JOB00	JAP002010P	処理開始	1		
JOB0020	JAP002010P	売上日付エラ	1		
JOB0020	JAP0020	処理終了	1		

3).シート3(ワーク)を作成しておく
 シート3がない場合のみ、内容は空白で追加しておきます。

3.Excel-VBAを起動
Altを押した状態でF8キーを押します。

4.[マクロ名(M):]に'test'と入力(''は不要、''内のtestを入力)

5.[作成(C)]をクリック

6.以下のプログラムをドラッグ&コピー

'コンスタントデータを定義
    Const cnsBlank As String = " "
    Const cnsEqual As String = "="
'添え字などの変数を定義
    Dim i2, i2_max, i3, i3_max, j_tmp As Long
    Dim ptn_max As Long
    Dim flg_find As Long
    Dim text1 As String
'文字列処理の変数を定義
    Dim pos_now, pos_st, pos_end, pos_len As Long
'範囲を示す変数はRANGEで定義
    Dim rng_1, rng_tmp As Range
'FIND-NEXTの終了条件で使うためのアドレス(最初にもどったら終了)
    Dim rng_1_adrs As String
'データパターンによって書き込む列を分けるが最大値を取得
    i2_max = Sheets(2).Range("A1").End(xlDown).Row
    For i2 = 2 To i2_max
        If Sheets(2).Cells(i2, 4) > ptn_max Then
            ptn_max = Sheets(2).Cells(i2, 4)
        End If
    Next
'取得した最大値までの書き込むセルの内容を初期クリア
    For i2 = 2 To i2_max
      For j2 = 5 To 4 + ptn_max
        Sheets(2).Cells(i2, j2) = ""
      Next
    Next
'入力ファイル名が指定されているかのチェック
    If Dir(Sheets(1).Cells(2, 1)) = "" Then
'このプログラムは入力ファイルがなかったらメッセージを表示し終了
        MsgBox "入力ファイルがありません"
        Exit Sub
    End If
'入力ファイルを読み込みシート3へプール
      Open Sheets(1).Cells(2, 1) For Input As #1
      Sheets(3).Cells.Clear
'1行目は最初の検索に引っ掛からないので2行目から出力する。そのため初期は"1"
      i3 = 1
      Do Until EOF(1)
          Line Input #1, text1
          i3 = i3 + 1
'    原文をA列へ
          Sheets(3).Cells(i3, 1) = text1
'    ジョブ名をB列へ
          pos_st = 1
          pos_now = InStr(pos_st, Sheets(3).Cells(i3, 1), cnsBlank)
          pos_len = pos_now - pos_st
          Sheets(3).Cells(i3, 2) = Left(Sheets(3).Cells(i3, 1), pos_len)
'    プログラム名をC列へ
          pos_st = pos_now + 1
          pos_now = InStr(pos_st, Sheets(3).Cells(i3, 1), cnsBlank)
          pos_len = pos_now - pos_st
          Sheets(3).Cells(i3, 3) = Mid(Sheets(3).Cells(i3, 1), pos_st, pos_len)
'    メッセージをD列へ
          pos_st = pos_now + 1
          pos_len = Len(Sheets(3).Cells(i3, 1)) - pos_now
          Sheets(3).Cells(i3, 4) = Mid(Sheets(3).Cells(i3, 1), pos_st, pos_len)
      Loop
      i3_max = i3
      Close #1
'検索対象シートを先頭から検索するループ処理
      For i2 = 2 To i2_max
'    B列~D列を検索する
          Set rng_1 = Sheets(3).Range("B1:D" & i3_max)
          Set rng_tmp = rng_1.Find(Sheets(2).Cells(i2, 1), LookIn:=xlValues, lookat:=xlWhole)
'    検索状況をフラグにセット、エラーメッセージを表示することにも使用、成功時は"9"
'    処理の重複記述を避けるため検索パターンが"4"の場合も処理を抜けるようにしてある
          flg_find = 0
'    ジョブ名が無かったら対象データはスキップ
          If rng_tmp Is Nothing Then
              flg_find = 1
              GoTo L100
          End If
'    プログラム名、メッセージが無かった場合、Find-Next検索の終了条件を退避しておく
          rng_1_adrs = rng_tmp.Address
'    プログラム名、メッセージの検索ループ処理
          Do
'    ジョブ名が見つかったところの添え字を退避
              i3 = rng_tmp.Row
'    ジョブ名が等しいところの「プログラム名が等しいか」のチェック
              If Sheets(2).Cells(i2, 2) = Sheets(3).Cells(i3, 3) Then
'        等しい場合には「メッセージが存在するか」のチェック
                  pos_st = 1
                  pos_now = InStr(pos_st, Sheets(3).Cells(i3, 4), Sheets(2).Cells(i2, 3))
'        等しいメッセージが存在する場合には、全文字が等しく無くても「有った」ことになる
                  If pos_now <> 0 Then
'            そのためメッセージの「全文字が等しいか」をチェックする
                      pos_st = pos_now
                      pos_now = InStr(pos_st, Sheets(3).Cells(i3, 4), cnsBlank)
                      pos_len = pos_now - pos_st
                      If Sheets(2).Cells(i2, 3) = _
                           Mid(Sheets(3).Cells(i3, 4), pos_st, pos_len) Then
'            メッセージの全文字が等しい場合は、「検索成功」の"9"をセット
                          flg_find = 9
'            検索パターンをそのまま使うと長いので[j_tmp]にセット
                          j_tmp = Sheets(2).Cells(i2, 4)
                          Select Case j_tmp
'                検索パターン = 1 の場合
                          Case 1
                              pos_st = pos_now + 1
                              pos_end = Len(Sheets(3).Cells(i3, 4))
                              pos_len = pos_end + 1 - pos_st
                              Sheets(2).Cells(i2, 4 + j_tmp) = _
                                Mid(Sheets(3).Cells(i3, 4), pos_st, pos_len)
'                検索パターン = 2 の場合
                          Case 2
                              pos_st = pos_now
                              pos_now = InStr(pos_st, Sheets(3).Cells(i3, 4), cnsEqual)
                              pos_st = pos_now + 2
                              pos_now = InStr(pos_st, Sheets(3).Cells(i3, 4), cnsBlank)
'                    抽出対象が末尾の場合
                              If pos_now = 0 Then
                                  pos_end = Len(Sheets(3).Cells(i3, 4)) + 1
                                  pos_len = pos_end - pos_st
'                    抽出対象が途中にある場合(後ろにもメッセージがある場合)
                              Else
                                  pos_end = pos_now
                                  pos_len = pos_now - pos_st
                              End If
                              Sheets(2).Cells(i2, 4 + j_tmp) = _
                                Mid(Sheets(3).Cells(i3, 4), pos_st, pos_len)
'                このプログラムは1,2のみに対応しており、それ以外はエラー
                          Case Else
                              flg_find = 4
                          End Select
'             「プログラム名が全文字等しいか」かのチェックでNGの場合
                      Else
                          Set rng_tmp = rng_1.FindNext(rng_tmp)
                          flg_find = 3
                      End If
'         「プログラム名が等しいか」かのチェックでNGの場合
                  Else
                      Set rng_tmp = rng_1.FindNext(rng_tmp)
                      flg_find = 3
                  End If
'    ジョブ名が等しいところの「プログラム名が等しいか」のチェックでNGの場合
              Else
                 Set rng_tmp = rng_1.FindNext(rng_tmp)
                 flg_find = 2
              End If
          Loop Until flg_find = 4 Or flg_find = 9 Or rng_tmp.Address = rng_1_adrs
'ジョブ名が無かった場合のスキップ先のラベル、LOOPから抜けるためのラベル
L100:
          If flg_find <> 9 Then
              Sheets(2).Cells(i2, 5) = Sheets(2).Cells(1, flg_find) & "がありません"
          End If
      Next

6.以下に貼り付け(ペースト)

Sub test()
ここに貼り付ける
End Sub

7.F5キーで実行

8.実行結果の確認
設定シートに値が入っています。

またハードコピーは貼り付けませんが、ワークシートには読み込んだファイルが残っています。

プログラムの詳細説明

以下を除き、今回は説明を省きます。

詳細を確認したい場合は、姉妹版の記事を参照頂ければと思います。

◇異なるメッセージ表示方法に対応
上記サンプルデータで、プログラム名:JAP0010Pのメッセージは、1行にすべてを件数表示しています。

一方、プログラム名:JAP002010Pのメッセージは、件数を複数行で表示しています。


以下の制約事項の通りメッセージフォーマットを合わせれば、ジョブ名・プログラム名を単位にメッセージの内容を変えても抽出します。

制限事項

いくつかありますが、3つ書きます。

◇メッセージ内容が同じであること
・ジョブ名、プログラム名、メッセージの間の区切りに空白があること
・メッセージの内容も文字の間の区切りに空白があること
・メッセージの検索パターンが"1"の場合は、設定したメッセージ以降、最後までの文字列を抽出する
 具体的には、日付・時刻
・メッセージの検索パターンが"2"の場合は、設定したメッセージの後ろには"="があり、その後の文字列を抽出する
 具体的には、「受注ファイル入力 = xxxx」となっていること

◇データ量に制限がある
[1.設定シートの[ファイル名]を読み込み、ワークシートに格納する]で、ワークシートに格納できるデータ量はEXCELのバージョンによって異なります。

尚、当記事のプログラムは行数の上限をチェックしていません。

◇同じメッセージが複数ある場合は最初に見つかった内容を抽出する
同じジョブ名・プログラムが、朝、昼、夜に実行され複数のメッセージがある場合には、最初に見つかったメッセージから抽出します。

最後に

実際のメッセージに合わせた修正が必要になります。

データベースに独自構築したテーブルであれば、ファイルの読み込みステップはカットするなど修正が必要ですが、SQL文で抽出しワークシートに貼り付ければ使えます。

使うシーンに応じて対応して頂ければと思います。

EXCEL VBA
スポンサーリンク
- 面白かったらシェアお願いします! -
健史をフォローする
自分で改善

コメント