WordPressのプラグイン Pretty Links のクリック統計を集計する マクロ（Excel VBA）です。
Pretty Links 3.2.3 が出力するクリック統計で動作確認しています。
所詮Excelグラフなので、描画できる以上のデータを与えたり、ちょっと例外があると止まります（メンテナンスできる方向け）。
概要
PrettyLinks集計_Verx.x.xlsm
ボタンを押して、[Pretty Links]-[クリック統計] から出力されるcsvファイルを読み込ませてください。結果はデスクトップに「yymmddhhmmss_all_links_pretty_link_clicks_9-9999_9.xlsx」という名前で出力されます。
シートが3つ出力されます。
-
- ログ
クリック統計ファイルをExcelに取り込んだシートです。 - ピボットテーブルでLinkを集計したシート
クリック統計のうち Link と Timestamp を使ってピボットテーブルで集計したシートです。 - グラフ
クリック統計のうち Link と Timestamp を使ったグラフです。（Linkをマスクしています）
- ログ
コード
Sub PrettyLinksTotal()
Dim FSO As Object 'ファイルシステムオブジェクト
Dim FD As FileDialog, f As Variant 'ファイルダイアログ用変数
Dim DefaultPath As String 'ファイルダイアログのデフォルト表示パス
Dim wKLine As String '1行
Dim wkLineCm As Variant '1行をカンマ区切りで分割した配列
Dim wkData
Dim strBaseName As String '拡張子なしのファイル名
Dim blnTimestamp As Boolean 'Timestamp が存在するかどうかのフラグ
Dim blnLink As Boolean 'Link が存在するかどうかのフラグ
Dim xlsWorkbookOutput As Workbook '出力ファイル
Dim shName As String 'シート名（可変。csvファイルからつける）
Const shPivot As String = "Pivot_Link" 'シート名（固定）
Dim temp As Long '出力ファイル作成時のデフォルトワークシート数保存用
Dim x As Long, y As Long
Dim lngMaxCol As Long
Dim strOutputFileName As String '出力ファイル名
Const strExtName As String = "xlsx" '出力ファイル名の拡張子
Dim i As Long
Const intColHeadColer As Long = 15917529 '出力ファイルの表見出しの色（水色）
Dim strOutputFont As String '出力ファイルに使うフォント
'ファイルシステムオブジェクト
Set FSO = CreateObject("Scripting.FileSystemObject")
'出力ファイルに使うフォント
strOutputFont = ""
ThisWorkbook.Activate
Worksheets("tool").Select
Cells(1, 1).Select 'セルを選択してないとCommandbarsのListCountがエラーになる
With Application.CommandBars.FindControl(ID:=1728)
For i = 1 To .ListCount
If .List(i) = "BIZ UDゴシック" Then
strOutputFont = "BIZ UDゴシック"
Exit For
End If
Next i
End With
If strOutputFont = "" Then
strOutputFont = "ＭＳ ゴシック"
End If
'--------------------------------------
'ファイルダイアログ
'--------------------------------------
'ファイルダイアログ
Set FD = Application.FileDialog(msoFileDialogOpen)
'デフォルトで表示するフォルダ
DefaultPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\..\Downloads" & "\" 'ダウンロードフォルダ、"\"まで入れる
With FD
.AllowMultiSelect = False 'ファイルの複数選択は不可
.InitialFileName = DefaultPath 'デフォルトフォルダ
With .Filters
''「ファイルの種類」をクリア
.Clear
.Add "PrettyLinks", "*.csv"
End With
If .Show = True Then
'ダイアログが返したファイルの読み込み
For Each f In .SelectedItems
'--------------------------------------
'出力ファイル作成
'--------------------------------------
temp = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Set xlsWorkbookOutput = Workbooks.Add
Application.SheetsInNewWorkbook = temp
'シート名
strBaseName = FSO.GetBaseName(f)
shName = Left(strBaseName, 12) '「yyyymmddss_all_links_pretty_link_clicks_x-xxx.csv」の日付部（UTC)
xlsWorkbookOutput.ActiveSheet.Name = shName
'フォント（標準を変更）
xlsWorkbookOutput.Styles("Normal").Font.Name = strOutputFont
'ウィンドウ枠の固定
xlsWorkbookOutput.Worksheets(shName).Cells(2, 1).Select
ActiveWindow.FreezePanes = True
'列の幅
Columns("A:A").ColumnWidth = 15 'Browser
Columns("B:B").ColumnWidth = 10 'Browser Version
Columns("C:C").ColumnWidth = 15 'Platform
Columns("D:D").ColumnWidth = 18 'IP
Columns("E:E").ColumnWidth = 18 'Visitor ID
Columns("F:F").ColumnWidth = 22 'Timestamp
Columns("G:G").ColumnWidth = 40 'Host
Columns("H:H").ColumnWidth = 35 'URI
Columns("I:I").ColumnWidth = 40 'Referrer
Columns("J:J").ColumnWidth = 30 'Link
'列の書式
Columns("D:E").NumberFormatLocal = "@" '全列にデータがある項目のみ文字列（配列貼付するため）
Columns("F:F").NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
'ファイルの読み込み（カンマ区切り、ダブルコーテーション括り）
x = 0
blnTimestamp = False
blnLink = False
ReDim wkData(99999, 100) '適当に大きな配列
With CreateObject("ADODB.Stream")
.Charset = "UTF-8" '文字コード
.LineSeparator = 10 '改行LF（10）
'ファイルオープン
.Open
.LoadFromFile f
Do Until .EOS
wKLine = .ReadText(-2)
wkLineCm = Split(wKLine, ",")
x = x + 1
If x = 1 Then lngMaxCol = UBound(wkLineCm) + 1
If x > 99999 Then Exit Do
For y = 0 To UBound(wkLineCm)
If Len(wkLineCm(y)) >= 2 Then
'2文字以上
wkData(x - 1, y) = Mid(wkLineCm(y), 2, Len(wkLineCm(y)) - 2)
Else
'1文字以下ならそのまま出力（エラー回避）
wkData(x - 1, y) = wkLineCm(y)
End If
Next y
Loop
'ファイルクローズ
.Close
Worksheets(shName).Range("A1").Resize(99999, 100) = wkData
End With
'--------------------------------------
'出力ファイルの見栄え設定
'--------------------------------------
With xlsWorkbookOutput.Worksheets(shName)
'表見出しの背景色
.Range(Cells(1, 1), Cells(1, lngMaxCol)).Interior.Color = intColHeadColer
'オートフィルタ設定
.Cells.AutoFilter
End With
Next f
Else
Exit Sub
End If
End With
'出力ファイルがある場合
If Not xlsWorkbookOutput Is Nothing Then
'--------------------------------------
'ピボットテーブルの作成
'--------------------------------------
'1行目にTimestampとLinkが存在するかチェック（ピボットテーブルで使うため）
blnTimestamp = False
blnLink = False
For y = 0 To lngMaxCol
If Cells(1, y + 1) = "Timestamp" Then blnTimestamp = True
If Cells(1, y + 1) = "Link" Then blnLink = True
Next y
'TimestampとLinkがある場合、ピボットテーブルの作成
If blnTimestamp = True And blnLink = True Then
xlsWorkbookOutput.PivotCaches.Create(xlDatabase, _
Worksheets(shName).UsedRange).CreatePivotTable Sheets.Add.Range("A3")
With ActiveSheet.PivotTables(1)
.PivotFields("Link").Orientation = xlRowField 'Linkが縦
.PivotFields("Timestamp").Orientation = xlColumnField 'TimeStampが横
.PivotFields("Timestamp").AutoGroup 'TimeStampは日付型なので自動グループ化
.PivotFields("四半期").Orientation = xlHidden 'TimeStampの四半期は非表示（好み）
.PivotFields("年").ShowDetail = True 'TimeStampの年を展開
.PivotFields("Link").Orientation = xlDataField '集計する値
.PivotFields("Link").AutoSort xlDescending, "個数 / Link" '並び替え（降順）
End With
'シート名とタイトル
ActiveSheet.Name = shPivot
Cells(1, 1) = "Link 集計"
End If
'--------------------------------------
'出力ファイル保存
'--------------------------------------
DefaultPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
strOutputFileName = strBaseName
i = 0
Do
If FSO.FileExists(DefaultPath & "\" & strOutputFileName & "." & strExtName) = False Then
Exit Do
Else
'ファイル名
i = i + 1
strOutputFileName = strBaseName & "_" & i
End If
Loop
'ファイルを保存
xlsWorkbookOutput.SaveAs Filename:=DefaultPath & strOutputFileName & "." & strExtName
'--------------------------------------
'グラフ出力
'--------------------------------------
'積み上げ横棒グラフ
With Worksheets(shPivot).Shapes.AddChart.Chart
.ChartType = xlBarStacked
.SetSourceData Worksheets(shPivot).Range("A3").CurrentRegion
.Location Where:=xlLocationAsNewSheet
End With
With ActiveChart
'緑
.ChartColor = 26
'軸の要素の間隔
.FullSeriesCollection(1).Select
.ChartGroups(1).GapWidth = 50
'軸
.Axes(xlCategory).TickLabels.Font.Name = strOutputFont 'フォント
'凡例
With .Legend
.Position = xlCorner '位置は右上
.IncludeInLayout = False 'グラフに重ねて表示
.Font.Name = strOutputFont 'フォント
End With
End With
'グラフシート名
ActiveSheet.Name = "グラフ_Link"
'--------------------------------------
'出力ファイル上書き保存
'--------------------------------------
xlsWorkbookOutput.Save
End If
'完了メッセージ
MsgBox "終了しました。" & vbLf & vbLf & _
"出力ファイル：" & DefaultPath & xlsWorkbookOutput.Name & vbCrLf & vbCrLf, _
vbOKOnly + vbInformation, Title:="終了"
Set FSO = Nothing
Set FD = Nothing
Set f = Nothing
Set wkLineCm = Nothing
Set xlsWorkbookOutput = Nothing
End Sub
補足
- クリック統計のフォーマットのバリエーションは調べきれてませんが、デフォルトで出力されるフォーマットで問題なく動作することを確認して公開しています。もし動かない場合はどういう設定になっているのかご連絡ください。時間があるときに、私の環境で再現可能な範囲で善処します。
- クリック統計ファイルの最大行数がどこまでいくのかわからないのですが、ツール上は99999行読めるように作ってあります。行数が多くなると、Excelがまともに動くのかという心配がありますが…。
- クリック統計ファイルにおいて、Linksが多い場合や期間が長い場合、グラフ作成がエラーになったり、表示されるグラフがおかしくなるかもしれません。Excel側で上限値を設けていないのもあってきっちり作り込むのは難しそうです。代わりに、グラフ作成でエラーになる可能性を考慮して、作成直前で出力ファイルを保存するようにしました。（読み込ませるクリック統計ファイル側をエディタで加工して列を減らしてもらうのがよいです）
