#6 LINEトークの習慣を可視化！送信者別ヒストグラムで見るコミュニケーションの傾向
私たちの生活に欠かせないコミュニケーションツールであるLINE。日常のやりとりの中には、意識しないうちに独自のパターンや習慣が隠れています。今回の記事では、LINEのトーク履歴をもとに、送信者ごとのトーク頻度を時間帯ごとに可視化し、私たちのコミュニケーションスタイルがどのように時間とともに変化しているのかを掘り下げてみたいと思います。
たとえば、特定の友人とのやりとりが深夜に集中している理由や、仕事の同僚との連絡が日中に偏っている背景など、データをもとにコミュニケーションの特徴を紐解くことで、意外な発見があるかもしれません。ヒストグラムを用いた分析結果を通じて、より深い洞察を得る方法を探っていきましょう。
トーク履歴の出力からExcelへの読み込み方法は、こちらをご参考下さい
本日の分析：トークの時間帯を見る。
まずは、日時データから必要な情報を抽出します。
プロンプト
Excelのシート"LINEトーク履歴"には、以下のデータが記載されています。
A列：日時 フォーマットはyyyy/mm/dd hh:mm
B列：送信者
C列：メッセージ
A列のデータから、hhを取得し、D列へ記載して下さい。
mmは四捨五入して下さい。
例えば、10:25 であれば、hhは10、10:35であれば、hhは11、というようにです。
D列のヘッダーは、"時間"として下さい。
VBAでコードを生成して下さい。ChatGPT回答
以下は、指定された要件を満たすVBAコードです。このマクロは、「LINEトーク履歴」シートのA列から日時データを取得し、分を四捨五入して時間をD列に「時間」というヘッダーで記載します。
VBAコード
Sub ExtractAndRoundHour()
Dim ws As Worksheet
Dim lastRow As Long
Dim i As Long
Dim dt As Date
Dim hh As Integer
Dim mm As Integer
' シート名を指定
Set ws = ThisWorkbook.Sheets("LINEトーク履歴")
' D1セルにヘッダーを設定
ws.Range("D1").Value = "時間"
' データの最終行を取得（A列を基準）
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
' 2行目から最終行までループ
For i = 2 To lastRow
' A列の値が空でない場合に処理
If Not IsEmpty(ws.Cells(i, "A").Value) Then
' 日時を取得
dt = ws.Cells(i, "A").Value
' 時と分を取得
hh = Hour(dt)
mm = Minute(dt)
' 分が30以上なら時間を繰り上げ
If mm >= 30 Then
hh = hh + 1
' 24時を超えた場合は0時に戻す
If hh = 24 Then
hh = 0
End If
End If
' D列に時間を記載
ws.Cells(i, "D").Value = hh
End If
Next i
' メッセージボックスで完了を通知
MsgBox "時間の抽出と四捨五入が完了しました。", vbInformation
End Sub
コードの説明
シートの設定
Set ws = ThisWorkbook.Sheets("LINEトーク履歴")
処理対象のシートを「LINEトーク履歴」に設定します。
ヘッダーの設定
ws.Range("D1").Value = "時間"
D列の1行目に「時間」というヘッダーを設定します。
最終行の取得
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
A列の最終行を取得し、ループの範囲を決定します。
データのループ処理
For i = 2 To lastRow ' 処理内容 Next i
2行目から最終行まで順に処理を行います。
日時から時間と分の取得
dt = ws.Cells(i, "A").Value hh = Hour(dt) mm = Minute(dt)
A列の値を日時として取得し、Hour関数とMinute関数で時間と分を取得します。
分に基づく時間の四捨五入
If mm >= 30 Then hh = hh + 1 If hh = 24 Then hh = 0 End If End If
分が30以上の場合、時間を1繰り上げます。24時になる場合は0時にリセットします。
結果のD列への記載
ws.Cells(i, "D").Value = hh
計算した時間をD列に記載します。
完了メッセージの表示
MsgBox "時間の抽出と四捨五入が完了しました。", vbInformation
処理が完了したことをユーザーに通知します。
マクロの実行方法
VBAエディタの起動
Alt + F11 キーを押してVBAエディタを開きます。
新しいモジュールの挿入
メニューから 挿入 > 標準モジュール を選択します。
コードの貼り付け
上記のVBAコードを新しいモジュールに貼り付けます。
マクロの実行
F5 キーを押すか、VBAエディタ内で Run ボタンをクリックしてマクロを実行します。
注意点
バックアップの作成
マクロを実行する前に、データのバックアップを取ることをおすすめします。
データ形式の確認
A列のデータが正しく日時形式（yyyy/mm/dd hh:mm）で入力されていることを確認してください。不正な形式の場合、エラーが発生する可能性があります。
24時の処理
分が30以上で23時半以上の場合、時間が24時となり0時にリセットされます。必要に応じて、この挙動を調整してください。
このマクロを使用することで、「LINEトーク履歴」シートのA列から時間を効率的に抽出し、四捨五入した結果をD列に記載することができます。
実行結果
ここから本題。送信者ごと、時間ごとのヒストグラムを作成します。
プロンプト
"LINEトーク履歴"シートにおいて、
B列："送信者"
D列："時間"
のデータを使い、送信者ごとのヒストグラムを作成したいです。
ビンのサイズは1時間とし、24分割して下さい。
まずは、送信者ごとに、各時間のトーク数を集計して下さい。
次に、送信者ごとのヒストグラムを作成して下さい。
時間のヒストグラムは不要です。
一つのヒストグラム内に、各送信者のヒストグラムを並べてください。
送信者ごとの区別が出来るように、グラフの色を工夫して下さい。
作成先のシートは、"ヒストグラム(時間)"とし、存在しない場合は作成して下さい。
コードはVBAで生成して下さい。
For Eachを使用する場合は、バリアント型として下さい。
実行エラーにならないようにして下さい。ChatGPT回答
以下のサンプルコードは、シート「LINEトーク履歴」の B列（送信者）・D列（時間）をもとに、送信者ごとに 0～23 時をビンとするヒストグラムを作成します。
まず、送信者ごとの「各時間(0～23)」におけるトーク数を集計し、
続いて、「ヒストグラム(時間)」というシートに棒グラフ(Clustered Column)を作成します。
シート「ヒストグラム(時間)」が存在しない場合は自動で作成します。
送信者ごとに色を変えて系列が並ぶ形のグラフになります。
ポイント
VBAコード
Sub CreateHistogramBySender()
Dim wsSrc As Worksheet ' 元データ(「LINEトーク履歴」)シート
Dim wsDst As Worksheet ' ヒストグラム作成先シート
Dim lastRow As Long ' 元データの最終行
Dim dictSender As Object ' 送信者をキーとし、カウント配列を値として保持する辞書
Dim vSender As Variant ' 送信者名(Variant)
Dim hourVal As Variant ' 時間(Variant; 0～23)
Dim i As Long
'-------------------------
' 1. シートの取得・作成
'-------------------------
Set wsSrc = ThisWorkbook.Sheets("LINEトーク履歴")
On Error Resume Next
Set wsDst = ThisWorkbook.Sheets("ヒストグラム(時間)")
On Error GoTo 0
If wsDst Is Nothing Then
' 「ヒストグラム(時間)」シートが存在しない場合は新規作成
Set wsDst = ThisWorkbook.Worksheets.Add(After:=wsSrc)
wsDst.Name = "ヒストグラム(時間)"
End If
'-------------------------
' 2. 送信者の辞書を作成
'-------------------------
Set dictSender = CreateObject("Scripting.Dictionary")
' B列(送信者)の最終行を取得
lastRow = wsSrc.Cells(wsSrc.Rows.Count, "B").End(xlUp).Row
' B列から送信者を収集し、辞書に登録
' 辞書の値部分は「0～23 時のカウント」を保持する配列(24要素)にする
For i = 2 To lastRow
vSender = wsSrc.Cells(i, "B").Value
If Not dictSender.Exists(vSender) Then
Dim arr(0 To 23) As Long
dictSender.Add vSender, arr
End If
Next i
'-------------------------
' 3. 送信者×時間のトーク数を集計
'-------------------------
For i = 2 To lastRow
vSender = wsSrc.Cells(i, "B").Value
hourVal = wsSrc.Cells(i, "D").Value ' 0～23 の時間が入っている想定
' 時間が 0～23 の範囲であればカウント
If IsNumeric(hourVal) Then
If hourVal >= 0 And hourVal <= 23 Then
' dictSender(vSender) は 0～23 時間分の配列
Dim tmpArr() As Long
tmpArr = dictSender(vSender)
tmpArr(hourVal) = tmpArr(hourVal) + 1
dictSender(vSender) = tmpArr ' 更新した配列を戻す
End If
End If
Next i
'-------------------------
' 4. シートに集計結果を出力
'-------------------------
wsDst.Cells.Clear
' 見出し
wsDst.Range("A1").Value = "時間"
' 送信者一覧を Variant 配列で保持(辞書のキー)
Dim senderArr() As Variant
senderArr = dictSender.Keys ' dictSender.Keys は Variant の配列
' 見出し行(1行目)に送信者名を並べる
Dim colIndex As Long
colIndex = 2
Dim vKey As Variant ' For Each 用の Variant
For Each vKey In senderArr
wsDst.Cells(1, colIndex).Value = vKey
colIndex = colIndex + 1
Next vKey
' A列(行方向)に時間0～23を入力し、各送信者のカウントを出力
Dim hourLoop As Long
For hourLoop = 0 To 23
wsDst.Cells(hourLoop + 2, 1).Value = hourLoop
colIndex = 2
For Each vKey In senderArr
Dim hourCount() As Long
hourCount = dictSender(vKey)
wsDst.Cells(hourLoop + 2, colIndex).Value = hourCount(hourLoop)
colIndex = colIndex + 1
Next vKey
Next hourLoop
'-------------------------
' 5. グラフ(ヒストグラム)の作成
'-------------------------
' 既存のグラフオブジェクトがあれば削除（複数回実行でグラフが重複するのを防ぐ）
Dim co As ChartObject
For Each co In wsDst.ChartObjects
co.Delete
Next co
' 新規にグラフオブジェクトを追加
Dim chartObj As ChartObject
Set chartObj = wsDst.ChartObjects.Add( _
Left:=300, Top:=10, Width:=600, Height:=400)
Dim cht As Chart
Set cht = chartObj.Chart
cht.ChartType = xlColumnClustered ' クラスター型の縦棒グラフ
' グラフデータ範囲 (A1 から 24行分 × 送信者数 + 1列分)
Dim lastCol As Long
lastCol = dictSender.Count + 1 ' 時間列 + 送信者列数
cht.SetSourceData Source:=wsDst.Range( _
wsDst.Cells(1, 1), _
wsDst.Cells(24 + 1, lastCol) _
)
' グラフのタイトル・軸タイトルなど
cht.ChartTitle.Text = "送信者ごとのヒストグラム(時間)"
cht.HasLegend = True
cht.Axes(xlCategory).HasTitle = True
cht.Axes(xlCategory).AxisTitle.Caption = "時間"
cht.Axes(xlValue).HasTitle = True
cht.Axes(xlValue).AxisTitle.Caption = "トーク数"
' シリーズ(送信者)の名前を設定 & 色分け (自動配色でも良いが例示)
' SeriesCollection(1)が最初の送信者になる
Dim s As Long
For s = 1 To cht.SeriesCollection.Count
cht.SeriesCollection(s).Name = senderArr(s - 1)
' カラー設定を個別に行いたい場合のサンプル（自動で任意の色が付く設定でもOK）
' cht.SeriesCollection(s).Format.Fill.ForeColor.RGB = RGB( _
' (s * 50) Mod 255, (s * 100) Mod 255, (s * 150) Mod 255)
Next s
'-------------------------
' 完了メッセージ
'-------------------------
MsgBox "送信者ごとのヒストグラムを作成しました。", vbInformation
End Sub
処理の流れ
シート取得/作成
「LINEトーク履歴」シートを wsSrc として取得します。
「ヒストグラム(時間)」シートがない場合は新規作成し、wsDst として設定します。
辞書（Scripting.Dictionary）による送信者リストの作成
B列(送信者)を走査し、辞書のキーに送信者名、値として 0～23 のカウント配列を持たせます。
トーク数の集計
D列の時間(0～23)をもとに、該当する送信者のカウント配列をインクリメントします。
集計結果のシート出力
「ヒストグラム(時間)」シートを一旦クリアし、1行目に送信者名、A列に 0～23 の時間を設定します。
セルに対応するカウント値を書き込みます。
ヒストグラム(グラフ)の作成
既存のグラフがあれば削除し、新規にクラスター型の縦棒グラフを作成します。
グラフのデータ範囲は A1(見出し) から A25 相当(24行+1行) × 送信者列数ぶん。
グラフタイトルや軸タイトルを設定し、必要に応じて色分けを行います。
完了メッセージ
MsgBox でユーザーに完了を通知します。
使い方
VBAエディタの起動
Excel を開き、Alt + F11 キーでVBAエディタを開きます。
標準モジュールの挿入
メニューから 挿入 > 標準モジュール を選択し、上記コードを貼り付けます。
マクロの実行
VBAエディタ上で本マクロ(CreateHistogramBySender)を選択し、F5 を押下するか、実行ボタンを押すと処理が開始されます。
以上の手順で、B列＝送信者、D列＝時間(0～23) という形式のデータから、送信者別の時間ヒストグラムをシート「ヒストグラム(時間)」に作成できます。お試しください。
エラー発生のため、改修を依頼します。
プロンプト
cht.chartTitle.Text = "送信者ごとのヒストグラム(時間)"
ここでエラーになります。改修して下さい。ChatGPT回答
Excelのバージョンや設定によっては、グラフを作成した直後に cht.ChartTitle.Text = "..." を実行するとエラーが発生する場合があります。
グラフタイトルを設定する前に、下記のように cht.HasTitle = True を指定してから行うと、エラーが出ずに設定できます。
以下は修正後のマクロ例です。該当部分だけ修正しており、その他のロジックは前回回答と同じです。
Sub CreateHistogramBySender()
Dim wsSrc As Worksheet ' 元データ(「LINEトーク履歴」)シート
Dim wsDst As Worksheet ' ヒストグラム作成先シート
Dim lastRow As Long ' 元データの最終行
Dim dictSender As Object ' 送信者をキーとし、カウント配列を値として保持する辞書
Dim vSender As Variant ' 送信者名(Variant)
Dim hourVal As Variant ' 時間(Variant; 0～23)
Dim i As Long
'-------------------------
' 1. シートの取得・作成
'-------------------------
Set wsSrc = ThisWorkbook.Sheets("LINEトーク履歴")
On Error Resume Next
Set wsDst = ThisWorkbook.Sheets("ヒストグラム(時間)")
On Error GoTo 0
If wsDst Is Nothing Then
' 「ヒストグラム(時間)」シートが存在しない場合は新規作成
Set wsDst = ThisWorkbook.Worksheets.Add(After:=wsSrc)
wsDst.Name = "ヒストグラム(時間)"
End If
'-------------------------
' 2. 送信者の辞書を作成
'-------------------------
Set dictSender = CreateObject("Scripting.Dictionary")
' B列(送信者)の最終行を取得
lastRow = wsSrc.Cells(wsSrc.Rows.Count, "B").End(xlUp).Row
' B列から送信者を収集し、辞書に登録
' 辞書の値部分は「0～23 時のカウント」を保持する配列(24要素)にする
For i = 2 To lastRow
vSender = wsSrc.Cells(i, "B").Value
If Not dictSender.Exists(vSender) Then
Dim arr(0 To 23) As Long
dictSender.Add vSender, arr
End If
Next i
'-------------------------
' 3. 送信者×時間のトーク数を集計
'-------------------------
For i = 2 To lastRow
vSender = wsSrc.Cells(i, "B").Value
hourVal = wsSrc.Cells(i, "D").Value ' 0～23 の時間が入っている想定
' 時間が 0～23 の範囲であればカウント
If IsNumeric(hourVal) Then
If hourVal >= 0 And hourVal <= 23 Then
' dictSender(vSender) は 0～23 時間分の配列
Dim tmpArr() As Long
tmpArr = dictSender(vSender)
tmpArr(hourVal) = tmpArr(hourVal) + 1
dictSender(vSender) = tmpArr ' 更新した配列を戻す
End If
End If
Next i
'-------------------------
' 4. シートに集計結果を出力
'-------------------------
wsDst.Cells.Clear
' 見出し
wsDst.Range("A1").Value = "時間"
' 送信者一覧を Variant 配列で保持(辞書のキー)
Dim senderArr() As Variant
senderArr = dictSender.Keys ' dictSender.Keys は Variant の配列
' 見出し行(1行目)に送信者名を並べる
Dim colIndex As Long
colIndex = 2
Dim vKey As Variant ' For Each 用の Variant
For Each vKey In senderArr
wsDst.Cells(1, colIndex).Value = vKey
colIndex = colIndex + 1
Next vKey
' A列(行方向)に時間0～23を入力し、各送信者のカウントを出力
Dim hourLoop As Long
For hourLoop = 0 To 23
wsDst.Cells(hourLoop + 2, 1).Value = hourLoop
colIndex = 2
For Each vKey In senderArr
Dim hourCount() As Long
hourCount = dictSender(vKey)
wsDst.Cells(hourLoop + 2, colIndex).Value = hourCount(hourLoop)
colIndex = colIndex + 1
Next vKey
Next hourLoop
'-------------------------
' 5. グラフ(ヒストグラム)の作成
'-------------------------
' 既存のグラフオブジェクトがあれば削除（複数回実行でグラフが重複するのを防ぐ）
Dim co As ChartObject
For Each co In wsDst.ChartObjects
co.Delete
Next co
' 新規にグラフオブジェクトを追加
Dim chartObj As ChartObject
Set chartObj = wsDst.ChartObjects.Add(Left:=300, Top:=10, Width:=600, Height:=400)
Dim cht As Chart
Set cht = chartObj.Chart
cht.ChartType = xlColumnClustered ' クラスター型の縦棒グラフ
' グラフデータ範囲 (A1 から 24行分 × 送信者数 + 1列分)
Dim lastCol As Long
lastCol = dictSender.Count + 1 ' 時間列 + 送信者列数
cht.SetSourceData Source:=wsDst.Range( _
wsDst.Cells(1, 1), _
wsDst.Cells(24 + 1, lastCol) _
)
' グラフタイトルを設定する前に、タイトルを表示しておく
cht.HasTitle = True
cht.ChartTitle.Text = "送信者ごとのヒストグラム(時間)" ' ← ここでエラーが出にくくなる
cht.HasLegend = True
cht.Axes(xlCategory).HasTitle = True
cht.Axes(xlCategory).AxisTitle.Caption = "時間"
cht.Axes(xlValue).HasTitle = True
cht.Axes(xlValue).AxisTitle.Caption = "トーク数"
' シリーズ(送信者)の名前を設定 & 色分け (自動配色でもOK)
Dim s As Long
For s = 1 To cht.SeriesCollection.Count
cht.SeriesCollection(s).Name = senderArr(s - 1)
' ↓任意に色分けをしたい場合は下記を有効化し、好きなカラー設定に変更
' cht.SeriesCollection(s).Format.Fill.ForeColor.RGB = RGB( _
' (s * 50) Mod 255, (s * 100) Mod 255, (s * 150) Mod 255)
Next s
'-------------------------
' 完了メッセージ
'-------------------------
MsgBox "送信者ごとのヒストグラムを作成しました。", vbInformation
End Sub
修正ポイント
先に cht.HasTitle = True を設定してから、cht.ChartTitle.Text = "..." を実行するようにしました。
補足
Excel のバージョンや環境によっては、ChartTitle.Text の代わりに ChartTitle.Caption を利用しなければならない場合があります。
もし上記修正でもエラーが発生する場合、下記のように書き換えてみてください。 cht.HasTitle = True cht.ChartTitle.Caption = "送信者ごとのヒストグラム(時間)"同様にグラフ要素のアクセス方法がバージョンによって微妙に異なる場合があるため、Excelのバージョンが古い場合は、ChartTitleの設定前後の行をコメントアウトして実行してみるなどで原因を切り分けてください。
またまたエラー発生のため、改修を依頼します。
プロンプト
cht.SeriesCollection(s).Name = senderArr(s - 1)
ここで7エラーになります。改修して下さい。ChatGPT回答
以下の修正版コードでは、グラフの系列数と辞書で取得した送信者数の不整合で起きる「実行時エラー '9': インデックスが有効範囲にありません」(あるいは「Subscript out of range」) を回避するために、SetSourceDataではなく「新規系列を1つずつ追加」する方法に変更しています。
これにより、グラフの系列数と送信者の数が常に一致し、cht.SeriesCollection(s).Name = senderArr(s - 1)でエラーが発生しなくなります。
改修ポイント
グラフのデータ設定を、SetSourceData → SeriesCollection.NewSeries 方式に変更
手動で「カテゴリ用の範囲」「値用の範囲」を指定し、それを系列として追加します。
グラフタイトル設定の前に、HasTitle = True を確実に設定
一部環境でタイトル設定のときにエラーになる場合を回避します。
修正後のサンプルコード
Sub CreateHistogramBySender()
Dim wsSrc As Worksheet ' 元データ(「LINEトーク履歴」)シート
Dim wsDst As Worksheet ' ヒストグラム作成先シート
Dim lastRow As Long ' 元データの最終行
Dim dictSender As Object ' 送信者をキーとし、カウント配列(0～23)を値として保持する辞書
Dim vSender As Variant ' 送信者名(Variant)
Dim hourVal As Variant ' 時間(Variant; 0～23)
Dim i As Long
'============================
' 1. シートの取得・作成
'============================
Set wsSrc = ThisWorkbook.Sheets("LINEトーク履歴")
On Error Resume Next
Set wsDst = ThisWorkbook.Sheets("ヒストグラム(時間)")
On Error GoTo 0
If wsDst Is Nothing Then
' 「ヒストグラム(時間)」シートが存在しない場合は新規作成
Set wsDst = ThisWorkbook.Worksheets.Add(After:=wsSrc)
wsDst.Name = "ヒストグラム(時間)"
End If
'============================
' 2. 送信者の辞書を作成
'============================
Set dictSender = CreateObject("Scripting.Dictionary")
' B列(送信者)の最終行を取得
lastRow = wsSrc.Cells(wsSrc.Rows.Count, "B").End(xlUp).Row
' B列から送信者を収集し、辞書に登録
' 辞書のValueは0～23時のトーク数を持つLong型配列(24要素)
For i = 2 To lastRow
vSender = wsSrc.Cells(i, "B").Value
If Not dictSender.Exists(vSender) Then
Dim arr(0 To 23) As Long
dictSender.Add vSender, arr
End If
Next i
'============================
' 3. 送信者×時間のトーク数を集計
'============================
For i = 2 To lastRow
vSender = wsSrc.Cells(i, "B").Value
hourVal = wsSrc.Cells(i, "D").Value ' 0～23 の時間が入っている想定
If IsNumeric(hourVal) Then
If hourVal >= 0 And hourVal <= 23 Then
Dim tmpArr() As Long
tmpArr = dictSender(vSender)
tmpArr(hourVal) = tmpArr(hourVal) + 1
dictSender(vSender) = tmpArr ' 更新した配列を辞書に戻す
End If
End If
Next i
'============================
' 4. 集計結果を「ヒストグラム(時間)」シートに出力
'============================
wsDst.Cells.Clear
' 見出し
wsDst.Range("A1").Value = "時間"
' 送信者一覧を Variant 配列で保持(辞書のキー)
Dim senderArr() As Variant
senderArr = dictSender.Keys ' dictSender.Keys は Variant の配列
' 見出し行(1行目)に送信者名を横に並べる
Dim colIndex As Long
colIndex = 2
Dim vKey As Variant
For Each vKey In senderArr
wsDst.Cells(1, colIndex).Value = vKey
colIndex = colIndex + 1
Next vKey
' 行方向(2～25行目)に時間0～23を記入し、各送信者のカウントを並べる
Dim hourLoop As Long
For hourLoop = 0 To 23
wsDst.Cells(hourLoop + 2, 1).Value = hourLoop
colIndex = 2
For Each vKey In senderArr
Dim hourCount() As Long
hourCount = dictSender(vKey)
wsDst.Cells(hourLoop + 2, colIndex).Value = hourCount(hourLoop)
colIndex = colIndex + 1
Next vKey
Next hourLoop
'============================
' 5. グラフ(ヒストグラム)の作成
'============================
' 既存のグラフオブジェクトがあれば削除（複数回実行で重複するのを防ぐ）
Dim co As ChartObject
For Each co In wsDst.ChartObjects
co.Delete
Next co
' 新規グラフオブジェクトを追加
Dim chartObj As ChartObject
Set chartObj = wsDst.ChartObjects.Add(Left:=300, Top:=10, Width:=600, Height:=400)
Dim cht As Chart
Set cht = chartObj.Chart
cht.ChartType = xlColumnClustered
cht.HasTitle = True
cht.ChartTitle.Text = "送信者ごとのヒストグラム(時間)"
' 軸や凡例設定
cht.HasLegend = True
cht.Axes(xlCategory).HasTitle = True
cht.Axes(xlCategory).AxisTitle.Caption = "時間"
cht.Axes(xlValue).HasTitle = True
cht.Axes(xlValue).AxisTitle.Caption = "トーク数"
' 手動で系列を追加 (SetSourceDataではなく、SeriesCollection.NewSeries方式)
' カテゴリ軸 (0～23) は A2:A25
Dim catRange As Range
Set catRange = wsDst.Range("A2:A25") ' 行:2～25 => 時間0～23が24行分
' senderArr(0), senderArr(1), ... それぞれの列データを系列として追加
Dim s As Long
Dim totalSenders As Long
totalSenders = UBound(senderArr) - LBound(senderArr) + 1
For s = 0 To totalSenders - 1
cht.SeriesCollection.NewSeries
' カテゴリは時間
cht.SeriesCollection(s + 1).XValues = catRange
' 値 (YValues) は row2～25, col (2 + s) => (A=1, B=2, 送信者1がB列)
cht.SeriesCollection(s + 1).Values = wsDst.Range( _
wsDst.Cells(2, s + 2), _
wsDst.Cells(25, s + 2) _
)
' シリーズ名
cht.SeriesCollection(s + 1).Name = senderArr(s)
Next s
'============================
' 6. 完了メッセージ
'============================
MsgBox "送信者ごとのヒストグラムを作成しました。", vbInformation
End Sub
主な変更点
グラフへのデータ設定
SetSourceData を使わず、cht.SeriesCollection.NewSeries で系列を1つずつ明示的に追加する方式に変更しました。
これにより、系列数と送信者数(辞書のキー数)が必ず一致し、SeriesCollection(s).Name = senderArr(s - 1) 等で「配列の範囲外」エラーが発生することを防ぎます。
グラフタイトルの設定順序
cht.HasTitle = True を行ったあとに、cht.ChartTitle.Text = "..." を設定しています。
一部の環境でグラフ作成直後にタイトルを設定するとエラーになる場合があるため、順序を明確にしました。
使い方
VBAエディタの起動
Excelでファイルを開き、Alt + F11 キーを押してVBAエディタを開きます。
標準モジュールの挿入
メニューから 挿入 > 標準モジュール を選択し、上記のコードを貼り付けてください。
マクロの実行
VBAエディタ内で本マクロ(CreateHistogramBySender)を選択し、F5 キーを押すか、「実行」ボタンを押すと処理が開始されます。
このマクロを実行すれば、B列(送信者)とD列(0～23の時間)から集計したヒストグラムが、「ヒストグラム(時間)」シートに自動作成されます。
もし他にエラーや要望がありましたら、状況に応じて修正してみてください。
・・・3度目の正直で、ようやく動きました！
実行結果
朝は時間がないので、あまりLINEを使わない。
12時から13時までお昼休みなので、LINEのやりとりが活発
18時から22時までも、LINEのやりとりが活発だけど、23時以降は就寝
また、送信者が橙のほうがトーク数が多い。
以上の分析から、LINEのトーク履歴に基づく利用パターンが明らかになりました。特に、お昼休みや夕方以降の時間帯にやりとりが活発であり、送信者ごとにトーク数に差が見られることが特徴的です。
次回は、時系列でトーク数を見ていこうと思います。
おわり。