0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

LOGを整理するVBA

Posted at
Option Explicit
Public currentSheet As Object, currentRow As Long

Sub ParseLogFile()
    '=============================================
    'ログファイルを解析してExcelシートを作成するマクロ
    '=============================================
    
    Dim fs As Object, ts As Object
    Dim excelApp As Object, newWorkbook As Object
    Dim currentSheet As Object, currentRow As Long
    Dim logFilePath As String, line As String
    Dim sectionName As String, currentItem As String
    Dim itemCounter As Long, lineParts() As String
    
    'ログファイルパスの取得(B1セル指定)
    logFilePath = ThisWorkbook.Sheets(1).Range("B1").Value
    
    'ADODB.Streamオブジェクトの作成(UTF-8対応)
    Dim stream As Object
    Set stream = CreateObject("ADODB.Stream")
    stream.Charset = "utf-8"
    stream.Open
    stream.LoadFromFile logFilePath
    
    '新しいExcelアプリケーションの起動
    Set excelApp = CreateObject("Excel.Application")
    Set newWorkbook = excelApp.Workbooks.Add
    excelApp.Visible = True
    
    '初期設定
    Set currentSheet = Nothing
    itemCounter = 0
    
    'ログファイルの行処理
    Do Until stream.EOS
        line = Trim(stream.ReadText(-2))
        
        'セクションの判定(==== セクション名 ====)
        If Left(line, 4) = "====" And Right(line, 4) = "====" Then
            sectionName = Replace(Replace(line, "====", ""), " ", "")
            CreateNewSheet newWorkbook, sectionName
            currentRow = 1
            
        End If
        
        '小項目の判定(== 項目名)
        If Left(line, 3) = "== " Then
            itemCounter = 0
            currentItem = Trim(Replace(line, "==", ""))
            If currentRow > 2 Then currentRow = currentRow + 1
            
            '小項目ヘッダーの作成
            With currentSheet
                .Range("A" & currentRow & ":B" & currentRow).Interior.Color = RGB(0, 0, 255)
                .Range("A" & currentRow) = "No."
                .Range("B" & currentRow) = currentItem
                .Range("A" & currentRow & ":B" & currentRow).Font.Color = RGB(255, 255, 255)
                currentRow = currentRow + 1
            End With
        End If
        
        '通常行の処理
        If Left(line, 2) <> "==" And Len(line) > 0 Then
            itemCounter = itemCounter + 1
            With currentSheet
                .Range("A" & currentRow) = itemCounter
                .Range("B" & currentRow) = line
                .Range("A" & currentRow & ":B" & currentRow).Borders.LineStyle = 1
                currentRow = currentRow + 1
            End With
        End If
    Loop
    
    stream.Close
    Set stream = Nothing
End Sub

Sub CreateNewSheet(wb As Object, sheetName As String)
    '=============================================
    '新しいシートを作成するサブルーチン
    '=============================================
    On Error Resume Next
    wb.Sheets(sheetName).Delete
    On Error GoTo 0
    
    Dim newSheet As Object
    Set newSheet = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count))
    newSheet.Name = sheetName
    
    Set currentSheet = newSheet

End Sub
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?