アパッチのWEBアクセスログの集計④
2020年01月14日
アパッチのWEBアクセスログをエクセルVBAで集計したい。step1．フォルダ内の全ファイルを対象としたループを作る
step2．各ファイル内のデータを日付別にシート出力
step3．各シートで、ログデータを区切る
step4．区切られたデータを集計
前回step3を汎用性もたせて作り直した結果遅くなった。
今回はstep2を検討したら、step4のネタが思いつきました。
日付ごとにシートを分けるための処理。
まず、ログデータの日付情報は[の後の11文字が対象。
[の位置を検索して、次の文字から11文字をmidで取ればOKだね。
問題となるのは、新出のデータなら新しいシートに、
既出のデータなら既存のシートに出力する必要があること。
シート一覧を作ろうとすると、重複のしないリストを作る処理になるので、
検索してみた。
参考ページ（いつもお世話になってるオフィスOffice TANAKA）
http://officetanaka.net/excel/vba/tips/tips80.htm
前回step3を汎用性もたせて作り直した結果遅くなった。
今回はstep2を検討したら、step4のネタが思いつきました。
日付ごとにシートを分けるための処理。
まず、ログデータの日付情報は[の後の11文字が対象。
[の位置を検索して、次の文字から11文字をmidで取ればOKだね。
問題となるのは、新出のデータなら新しいシートに、
既出のデータなら既存のシートに出力する必要があること。
シート一覧を作ろうとすると、重複のしないリストを作る処理になるので、
検索してみた。
参考ページ（いつもお世話になってるオフィスOffice TANAKA）
http://officetanaka.net/excel/vba/tips/tips80.htm
重複しないリスト作りとして５つ紹介されてますが、
高速処理なVBAという観点で考えると（１）か（２）か。
（１）Dictionaryオブジェクト（連想配列）
（２）コレクション
前回作ったログデータをもとにIPアドレスやUAなどを集計したところ、
（２）のコレクションのほうが若干速い結果になった。
条件を変えて、全セルをユニークデータにしたところ、以下のとおり逆転。
（１）１０万行を１０秒
（２）１０万行を５０秒
高速に重複チェックをできるなら、カウントも入れればstep4で使えるじゃんってことで、
先にstep4をやることにした。
列のデータを配列に格納して、ユニークデータに対するカウント数を出力するマクロ。
ソースはこちら。
Sub 列集計_配列型()
'大文字小文字区別 空欄対応
Dim tictoc As Double
tictoc = Timer
Dim Col As Long: Col = Selection.Column
Dim Gyo As Long, GyoEnd As Long, TGyo As Long, ColName As String
If Cells(1, Col) <> "" Then
TGyo = 1
Else
TGyo = Cells(1, Col).End(xlDown).Row
End If
ColName = Cells(TGyo, Col).Text
GyoEnd = Cells(Rows.Count, Col).End(xlUp).Row
If GyoEnd = 1 Then
MsgBox "データがありません"
Exit Sub
End If
Dim Dic, i As Long, buf As String, Keys
Set Dic = CreateObject("Scripting.Dictionary")
For i = TGyo + 1 To GyoEnd
buf = Cells(i, Col).Value
If Not Dic.Exists(buf) Then
Dic.Add buf, 1
Else
Dic(buf) = Dic(buf) + 1
End If
Next i
''出力
Worksheets.Add
Dim oArr() As Variant
ReDim oArr(Dic.Count + 1, 2)
oArr(0, 0) = "№"
oArr(0, 1) = ColName
oArr(0, 2) = "カウント"
Keys = Dic.Keys
For i = 0 To Dic.Count - 1
oArr(i + 1, 0) = i + 1
oArr(i + 1, 1) = Keys(i)
oArr(i + 1, 2) = Dic(Keys(i))
Next i
Set Dic = Nothing
Dim NoCell As Range
Set NoCell = Cells(2, 1)
Call ArrayToCell(NoCell, oArr)
NoCell.AutoFilter
With ActiveSheet.AutoFilter.Range
.Sort Key1:=.Range("C2"), Order1:=xlDescending, Header:=xlYes
End With
Cells(1, 1) = Format(i, "#,##0種")
Cells(1, 2) = "合計："
Cells(1, 3) = Format(GyoEnd - TGyo, "#,##0件")
On Error Resume Next
ActiveSheet.Name = ColName & "_内訳"
Call ArrayToCell(NoCell, oArr, 1) ' №の入った１列目だけ再出力
'Debug.Print "[" & Now & "] "; Format(GyoEnd - 1, "#,##0行を") & Format(Timer - tictoc, "0.00秒")
End Sub
コメント
Sub ArrayToCell(Target As Range, oArr, Optional ColCnt As Long = 0) '配列貼り付け便利モジュール
Dim iRow '// データ設定用の行カウンタ
Dim iCol '// データ設定用の列カウンタ
Dim iRowMax '// 二次元配列の最大行数
Dim iColMax '// 二次元配列の最大列数
'// １次元目の要素数を取得
iRowMax = UBound(oArr, 1) - LBound(oArr, 1) + 1
'// ２次元目の要素数を取得
iColMax = UBound(oArr, 2) - LBound(oArr, 2) + 1
'// Rangeオブジェクトで貼り付けるセル範囲を指定する場合
'Range(Cells(1, 1), Cells(iRowMax, iColMax)).Value = oArr
'// Rangeオブジェクトで開始セルから貼り付けるセル範囲を拡張する場合
If ColCnt > 0 And ColCnt <= iColMax Then
Target.Resize(iRowMax, ColCnt).Value = oArr
Else
Target.Resize(iRowMax, iColMax).Value = oArr
End If
End Sub
コメント
- 列データ集計は業務上使用頻度が高く、結構便利なモジュール。
- 重複のないリストを作るだけであれば、Dic.Exists(buf)の判定処理は不要だが
今回はカウント処理をするために残した。 - Dictionaryオブジェクトでは、キーデータはユニークである必要
試した結果、キーはブランクOK。大文字小文字の区別あり。
PR
Comment