Excelでダイヤグラム：路線情報を構造体にする
そんなわけで、タイトルも「Excelでダイヤグラム」になりました。
今日は、路線情報を構造体にします。
構造体でなくてもクラスという選択肢もありますが、路線情報のデータはほぼ読み込むだけで、データを使って何か操作したり、データ間の整合性を取ったりという処理がほぼないので、クラスにする必然性はありません。
なので、構造体にします。
以下のようになります。
Type 路線情報
路線名 As String
ダイヤ行 As Integer
下りデータ行 As Integer
上りデータ行 As Integer
駅数 As Integer
駅名() As String
駅間() As Integer
End Type
今は、標準モジュールを使っているので、Typeのスコープは気にしなくていいですが、もしシート別のモジュールを使うなら、Privateにする必要があります。
そうなると引数に使っているサブルーチンや関数が全部Privateになって、まあそれはそれでいいんですが、わざわざそんな手間をかける必要もないので、これでいきます。
路線を追加していいように、データやダイヤが始まる行を覚えます。
今は使いませんが、データは上り下り別になる予定です。
駅名と駅間は可変長配列にします。
駅間を距離など整数以外で持ちたいなら、Singleとかにしてください。
構造体の配列を取って、初期化します。
呼び出し側に可変長配列をつくって、こんな感じで。
Dim 路線() As 路線情報
Call 路線情報作成(路線, dataSheet)
呼び出し先で路線情報を読み取って、データ化します。
Sub 路線情報作成(路線() As 路線情報, sht As Worksheet)
rw = 1
idx = 0
Do While データ先頭(rw, sht)
s = sht.Cells(rw, 1).Value
nm = Mid(s, InStr(s, "【"))
ReDim Preserve 路線(idx)
路線(idx).路線名 = nm
路線(idx).下りデータ行 = rw
rw = rw + 1
cnt = 0
Do While sht.Cells(rw, 1).Value <> ""
ReDim Preserve 路線(idx).駅名(cnt)
路線(idx).駅名(cnt) = sht.Cells(rw, 1).Value
If cnt > 0 Then
ReDim Preserve 路線(idx).駅間(cnt - 1)
路線(idx).駅間(cnt - 1) = sht.Cells(rw, 2).Value
End If
cnt = cnt + 1
rw = rw + 1
Loop
路線(idx).駅数 = cnt
idx = idx + 1
Loop
End Sub
Function データ先頭(ByRef rw, sht As Worksheet)
For i = 1 To 5
If sht.Cells(rw, 1) <> "" Then
データ先頭 = True
Exit Function
End If
rw = rw + 1
Next
データ先頭 = False
End Function
2路線目のデータは作ってなくて動作は確認てきていませんが、5行の空白があればデータの終わりと認識します。
路線名は「下り【東横線】」のように、【】で囲んでその前に補足を付けます。
補足はA線とか内回りとか何でもいいですが、往復なら2回出てくるでしょう。
【】の範囲を路線名として認識します。
あとは、空行が出てくるまで駅名を、そして2駅目以降には駅間が記載されている想定です。
ReDimが曲者です。
配列の中に使いたい最大の添え字を書きます。要素数ではありません。
添え字って今でも使うのかな？最近はインデックスと呼んでる気がする。
Preserveはここまでのデータを保持して、領域を拡張する意味です。
この後は構造体を元にダイヤグラムを描いていきます。
線を引いてみた
今日は、線を引くところまでを目指します。
まずは、横軸です。
4時から翌日2時までの枠を作ります。
Excelの列を10分きざみに見立てて、1時間おきに罫線を入れて行きます。
列の幅は試行錯誤で決めました。
Sub 時刻設定(cnt)
Columns(1).ColumnWidth = 14
cl = 2
For hr = 4 To 25
Cells(2, cl).Value = hr
Cells(2, cl).HorizontalAlignment = xlLeft
Range(Cells(2, cl), Cells(cnt, cl)).Borders(xlEdgeLeft).LineStyle = xlContinuous
For i = 1 To 6
Columns(cl).ColumnWidth = 5.66
cl = cl + 1
Next
Next
Range(Cells(2, cl), Cells(cnt, cl)).Borders(xlEdgeLeft).LineStyle = xlContinuous
End Sub
次に縦軸です。
よくある方法は駅間の距離に基づいて決めるのですが、実はそれだと駅間が短い時に、ちょっとスロー走行することが多くて、その結果ダイヤが詰まり気味になります。
今回は駅間を所要時間で作ってみました。
そうすると直線になりやすくて、見た目が整います。
Sub 駅間設定(dataSheet As Worksheet)
rw = 2
Range(Cells(rw, 1), Cells(rw, 6 * 22 + 1)).Borders(xlEdgeBottom).LineStyle = xlContinuous
rw = rw + 1
Do While dataSheet.Cells(rw, 1).Value <> ""
Rows(rw).RowHeight = dataSheet.Cells(rw, 2).Value * 5
Range(Cells(rw, 1), Cells(rw, 6 * 22 + 1)).Borders(xlEdgeBottom).LineStyle = xlContinuous
rw = rw + 1
Loop
End Sub
そして、スジを引きます。
誤差の少ない時は一本の直線で引けるように、ちょっと工夫しています。
X座標はどうしても誤差が出るので、できるだけ誤差を作らないように列の座標を基準に決めています。
Sub スジ(dataSheet As Worksheet)
rw = 2
ox = dataSheet.Cells(rw, 3).Value
tx = ox
oy = Rows(rw + 1).Top
rw = rw + 1
Do While dataSheet.Cells(rw, 3).Value <> ""
dx = dataSheet.Cells(rw, 3).Value
dy = Rows(rw + 1).Top
tx = tx + TimeSerial(0, dataSheet.Cells(rw, 2).Value, 0)
If tx > dx Or tx <= dx - TimeSerial(0, 1, 0) Then
ActiveSheet.Shapes.AddConnector msoConnectorStraight, X座標(ox), oy, X座標(tx), dy
ox = dx
tx = ox
oy = dy
End If
rw = rw + 1
Loop
If oy <> dy Then
ActiveSheet.Shapes.AddConnector msoConnectorStraight, X座標(ox), oy, X座標(dx), dy
End If
End Sub
Function X座標(tm)
h = Hour(tm)
If h < 4 Then
h = h + 24
End If
m = Minute(tm)
dm = m \ 10
rm = m Mod 10
cl = (h - 4) * 6 + dm
bs = Columns(cl + 2).Left
of = (Columns(cl + 3).Left - bs) * rm / 10
X座標 = bs + of
End Function
結果はこんな感じです。
さて、スジらしくなりました。
この後は、後から改造しやすくするために、ソースの見直しをしたいと思います。
やりたいこと
今回挑戦するのは、「ダイヤグラムを描く」ことです。
鉄道好きな人なら、一度はやったことがあるんじゃないでしょうか。
時刻表から出発時間を拾いながら、グラフ用紙に線を引いていくような作業です。
鉄道関係なくても、数字をみたらビジュアル化するというのは、できる社会人の基本動作ですよね。
最初からいろいろな機能を作りこむのは大変なので、少しずつ作ります。
最初のインプットはこんな感じです。
そして、アウトプットはこんな感じです。
これを、マクロで自動生成したいということです。
まずは新しいシートを作成して、フォントを設定するマクロを作成しましょう。
駅間の狭いところがあると大きな字は書けないので、デフォルトを8ポイントにしました。
Meiryo UIを選ぶと、横に必要なスペースも少な目になります。
そして、駅名をコピーします。
上り下りの別はないので、そこは消します。
上りがある時のことは後日考えます。
今日の内容はこんな感じでした。
Sub ダイヤ生成()
Dim dataSheet As Worksheet
Set dataSheet = ActiveSheet
Call シート初期化(dataSheet)
Call 駅名コピー(dataSheet)
End Sub
Sub シート初期化(dataSheet As Worksheet)
Sheets.Add After:=dataSheet
Cells.Select
With Selection.Font
.Name = "Meiryo UI"
.Size = 8
End With
Range("A1").Select
End Sub
Sub 駅名コピー(dataSheet As Worksheet)
rw = 1
s = dataSheet.Cells(rw, 1).Value
n = InStr(s, "【")
If n <> 0 Then
s = Mid(s, n)
End If
Cells(rw, 1).Value = s
rw = rw + 1
Do While dataSheet.Cells(rw, 1).Value <> ""
Cells(rw, 1).Value = dataSheet.Cells(rw, 1).Value
rw = rw + 1
Loop
End Sub
