【ExcelVBA】IPCOMのログを自動で解析する。ブロックや許可通信を見える化。

Dim ログファイルフルパス
Sub IPCOMのアクセスログ解析()
    区切り文字 = "_,_"
    保護シート名 = Array("解析対象")
    Call シート削除(保護シート名)
    
    再使用判定 = 0
    If Not ログファイルフルパス = "" Then
        再使用判定 = MsgBox("同じファイルで再処理しますか？", vbYesNo + vbQuestion)
    End If
    If Not 再使用判定 = 6 Then
        ログファイルフルパス = Application.GetOpenFilename("テキスト,*.*?")
        If ログファイルフルパス = False Then Exit Sub
    End If
    
    ログリスト = ファイルの内容を配列へ格納(ログファイルフルパス)
    
    With Worksheets("解析対象")
        開始行 = 2
        最終行 = .Cells(Rows.Count, 1).End(xlUp).Row
        解析名称 = WorksheetFunction.Transpose(.Range(.Cells(開始行, 1), .Cells(最終行, 1)))
        一致条件 = WorksheetFunction.Transpose(.Range(.Cells(開始行, 2), .Cells(最終行, 2)))
        除外条件 = WorksheetFunction.Transpose(.Range(.Cells(開始行, 3), .Cells(最終行, 3)))
        一意項目 = WorksheetFunction.Transpose(.Range(.Cells(開始行, 4), .Cells(最終行, 4)))
    End With
    
    '件数格納用
    ReDim サマリ件数(LBound(解析名称) To UBound(解析名称))
    
    'シート作成
    Call シート作成(Array("サマリ"))
    For i = LBound(解析名称) To UBound(解析名称)
        Call シート作成(Array(解析名称(i)))
    Next
    '解析対象毎にサマリ用の件数を算出、またそれぞれの一意項目での更なるサマリも行う
    For i = LBound(解析名称) To UBound(解析名称)
        一致条件リスト = Split(一致条件(i), 区切り文字)
        除外条件リスト = Split(除外条件(i), 区切り文字)
        一意項目リスト = Split(一意項目(i), 区切り文字)
        
        '種類毎のサマリ作成
        種類毎ログ = フィルター(ログリスト, 一致条件リスト, 除外条件リスト)
        サマリ件数(i) = UBound(種類毎ログ) + 1
    
        '種類毎のシート作成
        If サマリ件数(i) < 1 Then GoTo ネクスト
        種類毎ユニークログ = ユニークリスト作成(種類毎ログ, 一意項目リスト)
        種類毎ユニークログ最小 = LBound(種類毎ユニークログ)
        種類毎ユニークログ最大 = UBound(種類毎ユニークログ)
        ReDim 種類毎ユニークログ件数(種類毎ユニークログ最小 To 種類毎ユニークログ最大)
        
        For j = LBound(種類毎ユニークログ) To UBound(種類毎ユニークログ)
            種類毎ユニークログリスト = Split(種類毎ユニークログ(j), " ")
            種類毎ユニークログ件数(j) = UBound(フィルター(種類毎ログ, 種類毎ユニークログリスト, Array(""))) + 1
            '一致しない場合の処理
            If 種類毎ユニークログ(j) = "" Then
                種類毎ユニークログ(j) = 該当なし
            End If
        Next
        With Worksheets(解析名称(i))
            .Range(.Cells(1, 1), .Cells(2, 2)) = ヘッダ作成(解析名称(i), 一意項目(i))
            
            開始行 = 3
'            .Cells(1, 1) = 解析名称(i)
            .Range(.Cells(種類毎ユニークログ最小 + 開始行, 1), .Cells(種類毎ユニークログ最大 + 開始行, 1)) = WorksheetFunction.Transpose(種類毎ユニークログ)
            .Range(.Cells(種類毎ユニークログ最小 + 開始行, 2), .Cells(種類毎ユニークログ最大 + 開始行, 2)) = WorksheetFunction.Transpose(種類毎ユニークログ件数)
            .Columns("A:A").AutoFit
        End With
ネクスト:
    Next
    解析名称最小 = LBound(解析名称)
    解析名称最大 = UBound(解析名称)
    With Worksheets("サマリ")
        .Range(.Cells(解析名称最小, 1), .Cells(解析名称最大, 1)) = WorksheetFunction.Transpose(解析名称)
        .Range(.Cells(解析名称最小, 2), .Cells(解析名称最大, 2)) = WorksheetFunction.Transpose(サマリ件数)
    End With
    
    分の単位 = 1
    '開始時間と終了時間を確認10分単位で集約
    
    With Worksheets("解析対象")
        開始行 = 2
        最終行 = .Cells(Rows.Count, 1).End(xlUp).Row
        解析名称 = WorksheetFunction.Transpose(.Range(.Cells(開始行, 1), .Cells(最終行, 1)))
        一致条件 = WorksheetFunction.Transpose(.Range(.Cells(開始行, 2), .Cells(最終行, 2)))
        除外条件 = WorksheetFunction.Transpose(.Range(.Cells(開始行, 3), .Cells(最終行, 3)))
        一意項目 = WorksheetFunction.Transpose(.Range(.Cells(開始行, 4), .Cells(最終行, 4)))
    End With
    j = 1
    Dim 集計テーブル()
    Dim 時刻リスト()
    For Each ログ In ログリスト
        データリスト = Split(ログ, " ")
        If ログ = "" Then
            GoTo ログネクスト
        End If
        If Not IsDate(データリスト(2)) Then
            GoTo ログネクスト
        End If
        時刻 = DateAdd("n", "0", データリスト(2))
        If 開始時刻 = "" Then
            開始時刻 = CDate(時刻)
            終了時刻 = DateAdd("n", 分の単位, 開始時刻)
        End If
時刻確認:
        ReDim Preserve 時刻リスト(1 To j)
        時刻リスト(j) = Format(開始時刻, "hh:mm")
        If 開始時刻 = DateAdd("n", "0", Format("00:03", "hhmm")) Then Stop

        If Format(開始時刻, "hhmmss") <= Format(時刻, "hhmmss") And _
            Format(時刻, "hhmmss") < Format(終了時刻, "hhmmss") Then
            
            '集計テーブル(1, i)にカウント
            For i = LBound(一致条件) To UBound(一致条件)
                一致条件リスト = Split(一致条件(i), 区切り文字)
                除外条件リスト = Split(除外条件(i), 区切り文字)
                該当数 = UBound(フィルター(Array(ログ, ""), 一致条件リスト, 除外条件リスト)) + 1
                ReDim Preserve 集計テーブル(1 To 5, 1 To j)
                If 該当数 > 0 Then
                    集計テーブル(i, j) = 集計テーブル(i, j) + 1
                Else
                    If 集計テーブル(i, j) = "" Then 集計テーブル(i, j) = 0
                End If
            Next
        Else
            j = j + 1
            開始時刻 = DateAdd("n", 分の単位, 開始時刻)
            終了時刻 = DateAdd("n", 分の単位, 終了時刻)
            GoTo 時刻確認
        End If
ログネクスト:
    Next
    With Worksheets("サマリ")
        最終行 = .Cells(Rows.Count, 1).End(xlUp).Row
        開始行 = 最終行 + 3
        開始列 = 1
        終了列 = 5
        .Cells(最終行 + 2, 開始列) = "グラフデータ"
        i = 0
        ヘッダ = Array("時刻", "拒否", "許可", "正常終了", "異常終了")
        For Each cell In .Range(.Cells(開始行, 開始列), .Cells(開始行, 終了列))
            cell.Value = ヘッダ(i)
            i = i + 1
        Next
        .Range(.Cells(開始行 + 1, 開始列), .Cells(開始行 + UBound(時刻リスト), 開始列)) = WorksheetFunction.Transpose(時刻リスト)
        .Range(.Cells(開始行 + 1, 開始列 + 1), .Cells(開始行 + UBound(集計テーブル, 2), 終了列)) = WorksheetFunction.Transpose(集計テーブル)
    End With
    
    'グラフ作成
    Worksheets("サマリ").Activate
    With ActiveSheet.Shapes.AddChart.Chart
        .ChartType = xlColumnClustered
        .SetSourceData Range(Cells(開始行, 開始列), Cells(開始行 + UBound(集計テーブル, 2), 終了列))
        .FullSeriesCollection(1).ChartType = xlLine
        .FullSeriesCollection(2).ChartType = xlColumnClustered
        .FullSeriesCollection(3).ChartType = xlColumnClustered
        .FullSeriesCollection(4).ChartType = xlLine
        .FullSeriesCollection(1).AxisGroup = 2
        .FullSeriesCollection(2).AxisGroup = 1
        .FullSeriesCollection(3).AxisGroup = 1
        .FullSeriesCollection(4).AxisGroup = 2
    End With
    ActiveSheet.ChartObjects(1).Top = Range(Cells(開始行, 終了列 + 1), Cells(開始行, 終了列 + 1)).Top
    ActiveSheet.ChartObjects(1).Left = Range(Cells(開始行, 終了列 + 1), Cells(開始行, 終了列 + 1)).Left
End Sub

Function ファイルの内容を配列へ格納(ファイルパス)
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set テキストファイル = FSO.OpenTextFile(ファイルパス)
    ファイルの内容を配列へ格納 = Split(テキストファイル.ReadAll, vbLf)
    テキストファイル.Close
End Function
Function フィルター(ソースリスト, 検索リスト, 除外リスト)
    フィルター結果 = ソースリスト
    For i = LBound(検索リスト) To UBound(検索リスト)
        If 検索リスト(i) <> "" Then
            フィルター結果 = Filter(フィルター結果, 検索リスト(i))
        End If
    Next
    For i = LBound(除外リスト) To UBound(除外リスト)
        If 除外リスト(i) <> "" Then
            フィルター結果 = Filter(フィルター結果, 除外リスト(i), False)
        End If
    Next
    フィルター = フィルター結果
End Function
Function ユニークリスト作成(ソースリスト, 項目リスト)
    If UBound(ソースリスト) < 0 Then Exit Function
    Dim ユニークコレクション As New Collection
    
    On Error Resume Next
        For i = LBound(ソースリスト) To UBound(ソースリスト)
            '任意の項目を抽出
            データリスト = Split(ソースリスト(i), " ")
            抽出 = ""
            For j = LBound(項目リスト) To UBound(項目リスト)
                If j > LBound(項目リスト) Then
                    抽出 = 抽出 & " "
                End If
                抽出 = 抽出 & Filter(データリスト, 項目リスト(j))(0)
            Next
            ユニークコレクション.Add 抽出, 抽出
        Next
    On Error GoTo 0
    'コレクションを配列に変換
    ReDim ユニークリスト(ユニークコレクション.Count - 1)
    For i = 1 To ユニークコレクション.Count
        ユニークリスト(i - 1) = ユニークコレクション(i)
    Next
    ユニークリスト作成 = ユニークリスト
End Function
Function シート削除(シートリスト)
    Application.DisplayAlerts = False
    For i = Worksheets.Count To 1 Step -1
        For k = LBound(シートリスト) To UBound(シートリスト)
            If Worksheets(i).Name = シートリスト(k) Then
                GoTo 次のシートチェックへ
            End If
        Next
        Worksheets(i).Delete
次のシートチェックへ:
    Next
    Application.DisplayAlerts = False
End Function
Function シート作成(シートリスト)
    For i = LBound(シートリスト) To UBound(シートリスト)
        With Sheets.Add(After:=Sheets(Sheets.Count))
            .Name = シートリスト(i)
        End With
    Next
End Function
'Function スプリット(文字, 区切り)
'    結果 = Split(文字, 区切り)
'    If IsArray(結果) Then
'        スプリット = 結果
'    Else
'        スプリット = Array("結果")
'    End If
'End Function
Function ヘッダ作成(解析名称, 一意項目)
    ReDim 貼り付け範囲(1 To 2, 1 To 2)
    貼り付け範囲(1, 1) = 解析名称
    貼り付け範囲(2, 1) = "一意の項目"
    貼り付け範囲(2, 2) = "件数"
    ヘッダ作成 = 貼り付け範囲
End Function
Sub デフォルトの設定にする()
    ActiveSheet.Name = "解析対象"
    With Worksheets("解析対象")
        デフォルト値 = Array("名称", "一致条件", "除外条件", "一意の項目", _
                            "拒否", "denied", "", "dst=_,_dstport=", _
                            "許可", "initiated", "", "dst=", _
                            "正常終了", "terminated_,_reason=fin", "", "dir=_,_src=_,_dst=", _
                            "異常終了", "terminated", "reason=fin_,_dstport=53", "dir=_,_dst=_,_dstport=_,_reason=")
        i = 0
        For Each cell In .Range("A1:D5")
            cell.Value = デフォルト値(i)
            i = i + 1
        Next
    End With
End Sub