忍者ブログ

ログデータの圧縮

2020年03月21日
今回はめっちゃ個人的な内容。

ログデータがでかいから必要な情報だけ取り出したい。

ログには、処理を開始したファイル名と
処理内容がつらつらと書かれているけど、
どのファイルにどんだけ時間がかかったかと
特定のキーワードの処理の番号をとりたい。

高速化のため、時間の範囲を絞る機能も盛り込んでどうやろか。。。

以下、ソース。やっぱDic配列便利だわぁ。
Option Explicit
Sub test()
    Dim Dic:    Set Dic = CreateObject("Scripting.Dictionary")
    Call LogNを解析(Dic, ファイル名取得())
    '   Call LogNを解析(Dic, "D:\Dropbox\VBA\WRN解析\20200320_1.log")
    Dim Items:  Items = Dic.Items
    
    Dim i As Long, j As Long, Vbuf
    Dim Arr() As String
    ReDim Arr(Dic.Count, 6)
    
    For i = 0 To UBound(Items)
        Vbuf = Split(Items(i), "‡")
        For j = 0 To UBound(Vbuf)
            Arr(i, j) = Vbuf(j)
        Next j
    Next i
    Range("A1").Resize(Dic.Count, 6) = Arr   ''1回だけ代入
     
End Sub
Sub LogNを解析(ByRef Dic, ファイル名 As String, Optional sTxt As String = "", Optional eTxt As String = "‡‡†‡‡")
    
    Dim i As Long, t As String
    Dim fCnt As Long, Fname As String
    Dim idCnt As Long, ID1 As String, IDN As String   'HAISIN_LIST.IDの数と最初と最後
    Dim T1 As String, TN As String
    Dim buf As String, Flag
    Dic.Add "title", "№" & "‡" & "日時" & "‡" & "Fname" & "‡" & "idCnt" & "‡" & "ID1" & "‡" & "IDN"
    Open ファイル名 For Input As #1
    Do Until EOF(1)
        Line Input #1, buf
        If buf Like "*" & sTxt & "*" And Flag = 0 Then
            Flag = 1  '書き込み開始
        ElseIf buf Like "*" & eTxt & "*" And Flag = 1 Then
            'Flag = 0    '書き込み終了
                    Dic.Add fCnt, fCnt & "‡" & t & "‡" & Fname & "‡" & idCnt & "‡" & ID1 & "‡" & IDN
            Exit Sub
        End If
        
        If Flag = 1 Then    '書き込み中
'            Debug.Print Buf
            If buf Like "*WRN*.txt*" Then   '条件はもっと細かくする必要あるかも
                If t <> "" Then 'tがあるなら格納できる
                    Dic.Add fCnt, fCnt & "‡" & t & "‡" & Fname & "‡" & idCnt & "‡" & ID1 & "‡" & IDN
                    idCnt = 0: ID1 = "": IDN = ""   '格納したら初期化
                End If
                '次のファイルに行くのでDic出力までやる
                fCnt = fCnt + 1 'ファイル№　=　Dicキー
                t = Mid(buf, 25, 19)
                Fname = WRNファイル名取得(buf)
            ElseIf buf Like "*HAISIN_LIST.ID*" Then
                idCnt = idCnt + 1
                If idCnt = 1 Then ID1 = 配信リストID取得(buf)
                IDN = 配信リストID取得(buf)
            Else
                '何もしない
            End If
        End If  ' If Flag = 1 Then    '書き込み中
    Loop
    Close #1
    
    If fCnt > 1 Then Dic.Add fCnt, fCnt & "‡" & t & "‡" & Fname & "‡" & idCnt & "‡" & ID1 & "‡" & IDN
    
End Sub
Sub LogNを解析b(ByRef Dic, ファイル名 As String, Optional sTxt As String = "", Optional eTxt As String = "‡‡†‡‡")
    
    Dim i As Long, t As String
    Dim fCnt As Long, Fname As String
    Dim idCnt As Long, ID1 As String, IDN As String   'HAISIN_LIST.IDの数と最初と最後
    Dim T1 As String, TN As String
    Dim buf As String, Flag
    Dic.Add "title", "№" & "‡" & "日時" & "‡" & "Fname" & "‡" & "idCnt" & "‡" & "ID1" & "‡" & "IDN"
    Open ファイル名 For Binary As #1
    Do Until EOF(1)
        Line Input #1, buf
        If buf Like "*" & sTxt & "*" And Flag = 0 Then
            Flag = 1  '書き込み開始
        ElseIf buf Like "*" & eTxt & "*" And Flag = 1 Then
            'Flag = 0    '書き込み終了
                    Dic.Add fCnt, fCnt & "‡" & t & "‡" & Fname & "‡" & idCnt & "‡" & ID1 & "‡" & IDN
            Exit Sub
        End If
        
        If Flag = 1 Then    '書き込み中
'            Debug.Print Buf
            If buf Like "*WRN*.txt*" Then   '条件はもっと細かくする必要あるかも
                If t <> "" Then 'tがあるなら格納できる
                    Dic.Add fCnt, fCnt & "‡" & t & "‡" & Fname & "‡" & idCnt & "‡" & ID1 & "‡" & IDN
                    idCnt = 0: ID1 = "": IDN = ""   '格納したら初期化
                End If
                '次のファイルに行くのでDic出力までやる
                fCnt = fCnt + 1 'ファイル№　=　Dicキー
                t = Mid(buf, 25, 19)
                Fname = WRNファイル名取得(buf)
            ElseIf buf Like "*HAISIN_LIST.ID*" Then
                idCnt = idCnt + 1
                If idCnt = 1 Then ID1 = 配信リストID取得(buf)
                IDN = 配信リストID取得(buf)
            Else
                '何もしない
            End If
        End If  ' If Flag = 1 Then    '書き込み中
    Loop
    Close #1
    
    If fCnt > 1 Then Dic.Add fCnt, fCnt & "‡" & t & "‡" & Fname & "‡" & idCnt & "‡" & ID1 & "‡" & IDN
    
End Sub
Function WRNファイル名取得(TextLine As String)
    Const Ln = 9
    Const keyText = ".txt"
    Dim pos As Long
    pos = InStr(TextLine, keyText)
    If pos < Ln Then
        WRNファイル名取得 = ""
    Else
        WRNファイル名取得 = Mid(TextLine, pos - Ln, Ln + Len(keyText))
    End If
End Function
Function 配信リストID取得(TextLine As String)
    Const Ln = 9
    Const keyText = "HAISIN_LIST.ID = "
    Dim pos As Long
    pos = InStr(TextLine, keyText)
    If pos < Ln Then
        配信リストID取得 = ""
    Else
        配信リストID取得 = Mid(TextLine, pos + Len(keyText), Ln)
    End If
End Function
Function ファイル名取得(Optional デフォルト As String = "")  'with ユーザー名取得
    If デフォルト = "" Then
        デフォルト = "C:\Users\" & ユーザー名取得() & "\Desktop"
    End If
    Dim i As Long
    '’https://excel-ubara.com/excelvba1/EXCELVBA376.html
    Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim FulName As String
    With Application.FileDialog(msoFileDialogFilePicker)
        '.InitialFileName = デフォルト
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "すべてのファイル", "*.*"
        .Title = "ファイルの選択"
        If .Show = True Then
            FulName = .SelectedItems(1)
        Else
            MsgBox "キャンセルしました"
        End If
    End With
    Set FSO = Nothing
    ファイル名取得 = FulName
End Function
Private Function ユーザー名取得()
    Dim WshNetworkObject As Object
    Set WshNetworkObject = CreateObject("WScript.Network")
    ユーザー名取得 = WshNetworkObject.UserName
    Set WshNetworkObject = Nothing
End Function

PR
Category・VBA | Comments(0)
Comment
  Vodafone絵文字 i-mode絵文字 Ezweb絵文字