MY LIFE IS...

The Lord of Flame has come.

嵐のセトリ解析が面倒くさくなってきたので、VBAの解析マクロを作ってみた

今まで黙々と手打ちで更新し続けていたセットリスト解析コーナー。
alstroemeria35412.hatenablog.com

しかし、公演数が増えれば増えるだけ「やってやれっか!!!!!」ってなります。
手打ちで曲名重複を省きつつ*1、曲数カウントして*2、比率を出すっていう。

この21世紀のデジタル社会に、何というアナログっぷりだと(笑)



ってことで、2時間クオリティで作り上げました。
プロトタイプです。

このセトリ一覧さえ作ってしまえば…
f:id:alstroemeria125:20161101024220p:plain

あとは、ぽちっとな!
f:id:alstroemeria125:20161101024139p:plain



テレレッテレー(*´∀`*)
f:id:alstroemeria125:20161101024244p:plain
…アッ、総公演数出すの忘れた…。



φ(。。;)カタカタカタカタ



f:id:alstroemeria125:20161101024540p:plain

フゥε-(‐ω‐;)






如何せんプロトタイプ過ぎて、かなり制限が強いのも確かです。
使えないことはないんですけどね。

使ってみたい!って人は後ろの方にマクロ載せてあるので使ってあげてください。
何かあっても保証はしませんけど*3




あ、マクロの記録方法は調べてください(丸投げ)
私はボタン作りましたけど、ぶっちゃけあってもなくてもいいですよ。
あった方が楽ですけど…。



【前提】
・「ツール」→「参照設定」で『Microsoft ActiveX Data Objects 6.X Library』にチェック
・セットリストを入力するシート名は『セットリスト一覧
・『セットリスト一覧』は2行目から実データ入力開始

こんくらいかな。
足りなかったら追記しておきます。



【マクロソース】
丸ごとコピーして、VBAのソースにペッと貼り付けてください。

Sub analyzeData()
Dim fromDataWorksheet As Worksheet
Dim toDataWorksheet As Worksheet

Dim maxRow As Long
Dim maxCol As Long
Dim searchFlg As Boolean

Dim dictionary As Object
Dim dictionaryKey
Dim buffer As String
Dim data As String

Set fromDataWorksheet = Worksheets("セットリスト一覧")

For Each toDataWorksheet In Worksheets
If toDataWorksheet.Name = "解析結果" Then
searchFlg = True
End If
Next toDataWorksheet
If searchFlg = False Then
Set toDataWorksheet = Worksheets.Add()
toDataWorksheet.Name = "解析結果"
toDataWorksheet.Move After:=fromDataWorksheet
End If
Set toDataWorksheet = Worksheets("解析結果")

Set dictionary = CreateObject("Scripting.Dictionary")
Set dictionaryKey = CreateObject("Scripting.Dictionary")

maxRow = fromDataWorksheet.Cells(Rows.Count, 1).End(xlUp).Row
maxCol = fromDataWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column



For fromCol = 1 To maxCol
For fromRow = 2 To maxRow
buffer = fromDataWorksheet.Cells(fromRow, fromCol).Value
If Not dictionary.Exists(buffer) Then
If buffer <> "" Then
dictionary.Add buffer, bufffer
End If
End If
Next fromRow
Next fromCol
dictionaryKey = dictionary.Keys

toDataWorksheet.Cells.Clear

For dataindex = 0 To dictionary.Count - 1
data = dictionaryKey(dataindex)
toDataWorksheet.Cells(dataindex + 3, 1) = dataindex + 1
toDataWorksheet.Cells(dataindex + 3, 2).Value = data
toDataWorksheet.Cells(dataindex + 3, 3).Value = WorksheetFunction.CountIf(fromDataWorksheet.Range(fromDataWorksheet.Cells(1, 1), fromDataWorksheet.Cells(maxRow, maxCol)), data)
Next dataindex

toDataWorksheet.Cells(1, 1).Value = "総数"
toDataWorksheet.Cells(1, 2).Value = WorksheetFunction.Sum(toDataWorksheet.Range(toDataWorksheet.Cells(3, 3), toDataWorksheet.Cells(dictionary.Count + 3, 3)))
toDataWorksheet.Cells(1, 3).Value = "総公演数"
toDataWorksheet.Cells(1, 4).Value = maxCol

maxRow = toDataWorksheet.Cells(Rows.Count, 1).End(xlUp).Row
For ratioRow = 3 To maxRow
toDataWorksheet.Cells(ratioRow, 4).Value = FormatPercent( (toDataWorksheet.Cells(ratioRow, 3) / toDataWorksheet.Cells(1, 2).Value), 2)
Next ratioRow

toDataWorksheet.Cells(2, 1).Value = "NO."
toDataWorksheet.Cells(2, 2).Value = "曲名"
toDataWorksheet.Cells(2, 3).Value = "回数"
toDataWorksheet.Cells(2, 4).Value = "比率"
toDataWorksheet.Columns("A").ColumnWidth = 5
toDataWorksheet.Columns("B").AutoFit

toDataWorksheet.Range(toDataWorksheet.Cells(3, 1), toDataWorksheet.Cells(maxRow, 4)).Sort Key1:=toDataWorksheet.Cells(3, 3), order1:=xlDescending, Key2:=toDataWorksheet.Cells(3, 2)
toDataWorksheet.Range(toDataWorksheet.Cells(2, 1), toDataWorksheet.Cells(2, 4)).Borders.LineStyle = xlContinuous
toDataWorksheet.Range(toDataWorksheet.Cells(2, 1), toDataWorksheet.Cells(2, 4)).Interior.Color = RGB(203, 206, 250)
toDataWorksheet.Range(toDataWorksheet.Cells(3, 1), toDataWorksheet.Cells(maxRow, 4)).Borders.LineStyle = xlContinuous
toDataWorksheet.Range(toDataWorksheet.Cells(3, 1), toDataWorksheet.Cells(maxRow, 4)).Borders(xlInsideHorizontal).LineStyle = xlDash
toDataWorksheet.Range(toDataWorksheet.Cells(3, 2), toDataWorksheet.Cells(maxRow, 2)).NumberFormatLocal = "@"

toDataWorksheet.Activate
End Sub

ちゃんと前提条件が合っていて、セットリストもちゃんと入力できていれば、最初みたいな解析が出来ると思います。



心配な人は、正直な話「あいうえお」とかでもいいですよ。

こんなデータを入れて、
f:id:alstroemeria125:20161101025912p:plain

マクロを起動すると、こんな感じ。
f:id:alstroemeria125:20161101030040p:plain



シンプルイズベスト✩



まあ、流れ的には、

①解析結果用のシートがなければ作る
②曲名が被ってなければ曲名を保持
③重複を排除した曲名を、解析結果用シートに書き出し
④曲名を元に、回数をカウント
⑤総曲数、総公演数算出
⑥総曲数 / 披露回数で比率算出
⑦書式設定

みたいな。

とりあえず、重複排除がクッソ面倒くさくてちょっと心折れそうになりました。

頑張った甲斐はあったけど、個人的に改善点は山ほどある…。
如何せんソースが見にくいったらありゃしない!

せめて、コメントくらい付けろっていう。
あと、インデックス系直書きしちゃってる部分が多いから、その辺直さないといらないバグを生みそう…
そして、曲数が増えれば増えるだけ時間もかかるぞ、これ\(^o^)/

大人な方々改善点があれば、アメとムチを使いこなして教えてください…。

*1:実際はVLOOKUPとか、COUNTIFとかの複合技使ってたけど

*2:これも重複排除さえできればCOUNTIFで弾き出せる

*3:シートへの書き込みしかしてないから大丈夫だとは思うけど