2023-05-20

Excelでダイヤグラム：上り下り

少し間が空きました。
上り下りの対応をしたいと思います。

データの見出しに、「下り【東横線】」と書いていました。
「【」以降が同じならば、同一の路線とみなすことにします。
下り上りでなくても、A線B線でも、内回り外回りでも気にしません。
下り上りで駅名が同じのチェックは入れましょう。

データはこんな感じです。

これを、こんな図に変換します。

データを読むときに、同じ路線なら路線情報を作らないようにします。

Sub 路線情報作成(路線() As 路線情報, sht As Worksheet)
    rw = 1
    idx = 0
    Do While データ先頭(rw, sht)
        s = sht.Cells(rw, 1).Value
        nm = Mid(s, InStr(s, "【"))
        If idx <> 0 Then
            pos = 路線検索(路線, nm)
        Else
            pos = -1
        End If
        
        reg = False
        If pos = -1 Then
            ReDim Preserve 路線(idx)
            路線(idx).路線名 = nm
            路線(idx).下りデータ行 = rw
            路線(idx).上りデータ行 = -1
            pos = idx
            idx = idx + 1
            reg = True
        Else
            If 路線(pos).上りデータ行 <> -1 Then
                MsgBox "3つめのデータ:" & nm
            End If
            路線(pos).上りデータ行 = rw
        End If
        rw = rw + 1
        cnt = 0
        Do While sht.Cells(rw, 1).Value <> ""
            If reg Then
                ReDim Preserve 路線(pos).駅名(cnt)
                路線(pos).駅名(cnt) = sht.Cells(rw, 1).Value
                If cnt > 0 Then
                    ReDim Preserve 路線(pos).駅間(cnt - 1)
                    路線(pos).駅間(cnt - 1) = sht.Cells(rw, 2).Value
                End If
            Else
                If 路線(pos).駅名(路線(pos).駅数 - cnt - 1) <> sht.Cells(rw, 1).Value Then
                    MsgBox "駅名不一致:" & 路線(pos).駅名(路線(pos).駅数 - cnt - 1) & "/" & sht.Cells(rw, 1).Value
                End If
            End If
            cnt = cnt + 1
            rw = rw + 1
        Loop
        If reg Then
            路線(pos).駅数 = cnt
        Else
            If 路線(pos).駅数 <> cnt Then
                MsgBox "駅数不一致:" & nm
            End If
        End If
    Loop
End Sub

Function 路線検索(路線() As 路線情報, nm)
    路線検索 = -1
    For i = 0 To UBound(路線)
        If 路線(i).路線名 = nm Then
            路線検索 = i
            Exit For
        End If
    Next i
End Function

で、上り下りは、y座標が異なることになります。

Sub スジ(路線() As 路線情報, dataSheet As Worksheet, diagSheet As Worksheet)
    dlta = 0.000001
    drw = 1
    For i = 0 To UBound(路線)
        cl = 3
        Do
            brw = 路線(i).下りデータ行
            irw = 1
            Do While irw < 路線(i).駅数 And dataSheet.Cells(brw + irw, cl).Value = ""
                irw = irw + 1
            Loop
            If dataSheet.Cells(brw + irw, cl).Value = "" Then
                Exit Do
            End If
            
            ox = dataSheet.Cells(brw + irw, cl).Value
            tx = ox
            oy = drw + irw
            irw = irw + 1
            With dataSheet
                clr = .Range(.Cells(brw, cl), .Cells(brw, cl)).Font.Color
            End With
            wgt = 0.5
            If dataSheet.Cells(brw, cl) <> "" Then
                wgt = 1.2
            End If
            
            Do While irw <= 路線(i).駅数
                If dataSheet.Cells(brw + irw, cl).Value = "" Then
                    Exit Do
                End If
                dx = dataSheet.Cells(brw + irw, cl).Value
                tx = tx + TimeSerial(0, 路線(i).駅間(irw - 2), 0)
                If dx <> "↓" Then
                    If tx > dx + dlta Then
                        Call 線描画(diagSheet, ox, oy, dx, drw + irw, clr, wgt)
                        ox = dx
                        tx = dx
                        oy = drw + irw
                    ElseIf tx <= dx - TimeSerial(0, 1, 0) - dlta Then
                        Call 線描画(diagSheet, ox, oy, tx, drw + irw, clr, wgt)
                        ox = dx
                        tx = dx
                        oy = drw + irw
                    End If
                End If
                irw = irw + 1
            Loop
            If oy <> drw + irw - 1 Then
                Call 線描画(diagSheet, ox, oy, dx, drw + irw - 1, clr, wgt)
            End If
            cl = cl + 1
        Loop
        If 路線(i).上りデータ行 <> -1 Then
            cl = 3
            Do
                brw = 路線(i).上りデータ行
                irw = 1
                Do While irw < 路線(i).駅数 And dataSheet.Cells(brw + irw, cl).Value = ""
                    irw = irw + 1
                Loop
                If dataSheet.Cells(brw + irw, cl).Value = "" Then
                    Exit Do
                End If
                
                ox = dataSheet.Cells(brw + irw, cl).Value
                tx = ox
                oy = drw + 路線(i).駅数 - irw + 1
                irw = irw + 1
                With dataSheet
                    clr = .Range(.Cells(brw, cl), .Cells(brw, cl)).Font.Color
                End With
                wgt = 0.5
                If dataSheet.Cells(brw, cl) <> "" Then
                    wgt = 1.2
                End If
                
                Do While irw <= 路線(i).駅数
                    If dataSheet.Cells(brw + irw, cl).Value = "" Then
                        Exit Do
                    End If
                    dx = dataSheet.Cells(brw + irw, cl).Value
                    tx = tx + TimeSerial(0, 路線(i).駅間(路線(i).駅数 - irw), 0)
                    If dx <> "↓" Then
                        If tx > dx + dlta Then
                            Call 線描画(diagSheet, ox, oy, dx, drw + 路線(i).駅数 - irw + 1, clr, wgt)
                            ox = dx
                            tx = dx
                            oy = drw + 路線(i).駅数 - irw + 1
                        ElseIf tx <= dx - TimeSerial(0, 1, 0) - dlta Then
                            Call 線描画(diagSheet, ox, oy, tx, drw + 路線(i).駅数 - irw + 1, clr, wgt)
                            ox = dx
                            tx = dx
                            oy = drw + 路線(i).駅数 - irw + 1
                        End If
                    End If
                    irw = irw + 1
                Loop
                If oy <> drw + 路線(i).駅数 - irw + 2 Then
                    Call 線描画(diagSheet, ox, oy, dx, drw + 路線(i).駅数 - irw + 2, clr, wgt)
                End If
                cl = cl + 1
            Loop
        End If
        drw = drw + 路線(i).駅数 + 2
    Next i
End Sub

かなりゴチャゴチャしてきたので、見直しをした方がよさそうですが、今日はここまでにします。

2023-04-23

Excelでダイヤグラム：リファクタリング

プログラムの動作を変えずに、ソースコードをきれいにすることをリファクタリングと言います。
なんだけど、リファクタリングして動作が変わらないということをどうやって保証するか。

仕事の時はちゃんと悩みますが、今回は出力したダイヤが同じならOKなので、気持ちよくリファクタリングしましょう。

基本は似ているコードの共通化＝関数・サブルーチン切り出しです。
今回はここを対応しました。

Sub 線描画(sht As Worksheet, ox, oy, dx, dy, clr, wgt)
    With sht.Shapes.AddConnector(msoConnectorStraight, _
                    X座標(ox, sht), sht.Rows(oy + 1).Top, X座標(dx, sht), sht.Rows(dy + 1).Top)
        .Line.ForeColor.RGB = clr
        .Line.Weight = wgt
    End With
End Sub

呼び出し側でも対応すればOKです。

            Do While irw <= 路線(i).駅数
                If dataSheet.Cells(brw + irw, cl).Value = "" Then
                    Exit Do
                End If
                dx = dataSheet.Cells(brw + irw, cl).Value
                tx = tx + TimeSerial(0, 路線(i).駅間(irw - 2), 0)
                If dx <> "↓" Then
                    If tx > dx + dlta Then
                        Call 線描画(diagSheet, ox, oy, dx, brw + irw, clr, wgt)
                        ox = dx
                        tx = dx
                        oy = brw + irw
                    ElseIf tx <= dx - TimeSerial(0, 1, 0) - dlta Then
                        Call 線描画(diagSheet, ox, oy, tx, brw + irw, clr, wgt)
                        ox = dx
                        tx = dx
                        oy = brw + irw
                    End If
                End If
                irw = irw + 1
            Loop
            If oy <> brw + irw - 1 Then
                Call 線描画(diagSheet, ox, oy, dx, brw + irw - 1, clr, wgt)
            End If

はい、ひとつバグが見つかっていますね。
デルタ値は、違っても気にしないということなので、以下の行で加減が違ってました。

                    ElseIf tx <= dx - TimeSerial(0, 1, 0) - dlta Then

出力結果がちょっと変わりましたが、いい方向に変わってる感じなのでOKです。

もうちょっとリファクタリングしてみたいところはありますが、次は上りの線を引いてみたいと思います。

2023-04-16

Excelでダイヤグラム：問題修正

ひとつ問題に気が付きました。
駅名が下寄せされていない。

下寄せは、Range(・・).VerticalAlignmentで設定できます。
で、それを修正しようとしてもう一つ問題発見。

            diag.Range(Cells(rw, 1), Cells(rw, 6 * 22 + 1)).Borders(xlEdgeBottom).LineStyle = xlContinuous

ここで、Cellsだとアクティブシートのセルを参照してしまいます。
そんなわけで、2行ほど修正します。

Sub 路線設定(路線() As 路線情報, diag As Worksheet)
    rw = 1
    For i = 0 To UBound(路線)
        路線(i).ダイヤ行 = rw
        diag.Cells(rw, 1).Value = 路線(i).路線名
        rw = rw + 1
        For j = 1 To 路線(i).駅数
            diag.Cells(rw, 1).Value = 路線(i).駅名(j - 1)
            diag.Range(diag.Cells(rw, 1), diag.Cells(rw, 1)).VerticalAlignment = xlBottom
            If j <> 1 Then
                diag.Rows(rw).RowHeight = 路線(i).駅間(j - 2) * 5
            End If
            diag.Range(diag.Cells(rw, 1), diag.Cells(rw, 6 * 22 + 1)).Borders(xlEdgeBottom).LineStyle = xlContinuous
            rw = rw + 1
        Next j
        For hr = 4 To 26
            cl = hr * 6 - 22
            diag.Cells(路線(i).ダイヤ行 + 1, cl).Value = hr
            diag.Cells(路線(i).ダイヤ行 + 1, cl).HorizontalAlignment = xlLeft
            diag.Range(diag.Cells(路線(i).ダイヤ行 + 1, cl), diag.Cells(rw - 1, cl)).Borders(xlEdgeLeft).LineStyle = xlContinuous
        Next
        rw = rw + 1
    Next i
End Sub

次回は全体見直しの想定です。

2023-04-15

Excelでダイヤグラム：優等列車の設定

今日は優等列車の設定です。
データの書き方を決めましょう。

先頭行に列車種別を描いています。
字はなんでもいいですが、色をスジに反映しようと思います。
通過のマークを決めます。
紙で時刻表を見てた人はレのような片側矢印がおなじみですが、ここは普通に下向き矢印にしました。

土休日ダイヤですが、渋谷発の最初の急行は、新横浜線直通なんだ。。。
で、それを受けて、日吉始発の各停と急行が。

それは置いといて、VBAの対応です。
通過駅の対応は判断文一つでOKです。

                    If dx <> "↓" Then
                        If tx > dx + dlta Then
                        ・・・・
                    EndIf

線の色と太さを決めます。
太さは小数点以下切り上げのような気がします。

            With dataSheet
                clr = .Range(.Cells(brw, cl), .Cells(brw, cl)).Font.Color
            End With
            wgt = 0.5
            If dataSheet.Cells(brw, cl) <> "" Then
                wgt = 1.2
            End If

色と太さは線を引くところで設定します。
ちょっと独特な書き方になります。

                        With diagSheet.Shapes.AddConnector(msoConnectorStraight, _
                                X座標(ox, diagSheet), diagSheet.Rows(oy + 1).Top, _
                                X座標(dx, diagSheet), diagSheet.Rows(brw + irw + 1).Top)
                            .Line.ForeColor.RGB = clr
                            .Line.Weight = wgt
                        End With

いい感じの出力になりました。

ちょっとソースがごちゃついてきたので、少し見直しもかけたいと思います。

2023-04-11

Excelでダイヤグラム：スジを複数引く

少し間が空いてしまいましたが、再開です。
今日のテーマはスジを複数引くことです。
同時に、途中駅発とか、途中駅終着とかの対応もしましょう。

データはこんな感じです。

既に縦横は変数にしてあったので、対応は限定的でした。

Sub スジ(路線() As 路線情報, dataSheet As Worksheet, diagSheet As Worksheet)
    dlta = 0.000001
    For i = 0 To UBound(路線)
        cl = 3
        Do
            brw = 路線(i).下りデータ行
            irw = 1
            Do While irw < 路線(i).駅数 And dataSheet.Cells(brw + irw, cl).Value = ""
                irw = irw + 1
            Loop
            If dataSheet.Cells(brw + irw, cl).Value = "" Then
                Exit Do
            End If
            
            ox = dataSheet.Cells(brw + irw, cl).Value
            tx = ox
            oy = brw + irw
            irw = irw + 1
            Do While irw <= 路線(i).駅数
                If dataSheet.Cells(brw + irw, cl).Value = "" Then
                    Exit Do
                End If
                dx = dataSheet.Cells(brw + irw, cl).Value
                tx = tx + TimeSerial(0, 路線(i).駅間(irw - 2), 0)
                If tx > dx + dlta Then
                    diagSheet.Shapes.AddConnector msoConnectorStraight, _
                            X座標(ox, diagSheet), diagSheet.Rows(oy + 1).Top, _
                            X座標(dx, diagSheet), diagSheet.Rows(brw + irw + 1).Top
                    ox = dx
                    tx = dx
                    oy = brw + irw
                ElseIf tx <= dx - TimeSerial(0, 1, 0) + dlta Then
                    diagSheet.Shapes.AddConnector msoConnectorStraight, _
                            X座標(ox, diagSheet), diagSheet.Rows(oy + 1).Top, _
                            X座標(tx, diagSheet), diagSheet.Rows(brw + irw + 1).Top
                    ox = dx
                    tx = dx
                    oy = brw + irw
                End If
                irw = irw + 1
            Loop
            If oy <> brw + irw - 1 Then
                diagSheet.Shapes.AddConnector msoConnectorStraight, _
                            X座標(ox, diagSheet), diagSheet.Rows(oy + 1).Top, _
                            X座標(dx, diagSheet), diagSheet.Rows(brw + irw).Top
            End If
            cl = cl + 1
        Loop
    Next i
End Sub

横はclが増えていく感じで、空白の列に達すると終了するようにします。
縦はデータが見つかったら開始行で、データがなくなったら終了行にします。
このへんになると、VBA書いた瞬間は何かと境界条件とかが怪しくなりがちで、
実行結果を見ながらデバッグします。
これで大丈夫そうです。

2023-04-03

Excelでダイヤグラム：スジを引く

スジを引くところを、路線情報に対応します。
複数路線、上り下り、複数列車の準備をしますが、まだ未確認です。

Sub スジ(路線() As 路線情報, dataSheet As Worksheet, diagSheet As Worksheet)
    dlta = 0.000001
    For i = 0 To UBound(路線)
        cl = 3
        brw = 路線(i).下りデータ行
        ox = dataSheet.Cells(brw + 1, cl).Value
        tx = ox
        oy = brw + 1
        For irw = 2 To 路線(i).駅数
            dx = dataSheet.Cells(brw + irw, cl).Value
            tx = tx + TimeSerial(0, 路線(i).駅間(irw - 2), 0)
            If tx > dx + dlta Then
                diagSheet.Shapes.AddConnector msoConnectorStraight, _
                            X座標(ox, diagSheet), diagSheet.Rows(oy + 1).Top, _
                            X座標(dx, diagSheet), diagSheet.Rows(brw + irw + 1).Top
                ox = dx
                tx = dx
                oy = brw + irw
            ElseIf tx <= dx - TimeSerial(0, 1, 0) + dlta Then
                diagSheet.Shapes.AddConnector msoConnectorStraight, _
                            X座標(ox, diagSheet), diagSheet.Rows(oy + 1).Top, _
                            X座標(tx, diagSheet), diagSheet.Rows(brw + irw + 1).Top
                ox = dx
                tx = dx
                oy = brw + irw
            End If
        Next irw
        If oy <> brw + 路線(i).駅数 Then
            diagSheet.Shapes.AddConnector msoConnectorStraight, _
                            X座標(ox, diagSheet), diagSheet.Rows(oy + 1).Top, _
                            X座標(dx, diagSheet), diagSheet.Rows(brw + 路線(i).駅数 + 1).Top
        End If
    Next i
End Sub

今回のポイントは、デルタ値の導入です。
時刻は1日を1とした数で表示されるので、1時間は1÷24、1分は1÷24÷60になります。
この数字は割り切れないので、誤差が出ます。
この誤差の許容範囲がデルタ値です。
渋谷から中目黒の標準時間が4分なので、渋谷5:00発だと中目黒5:04発になります。
これはその通りなので、ここでスジを分ける必要はありません。
一方、自由が丘だと標準時間で5:12のはずが、自由が丘発の発時刻は5:13です。
実際東急のページで時刻を確認すると自由が丘着は5:11で、少し停車していることがわかります。
これは優等列車退避の場合も適用できるので、ルールを設けます。
最初の版とはルールを少し見直しました。
発時刻が標準時間より早い時は、それに合わせてスジを引きます。
発時刻が標準時間より1分以上遅い時は、きっと停車時間があると考え、標準時間で着いて発時間まで待っているという認識にします。
この判定にデルタ値を許容誤差として追加しています。
最後に終着までのスジを引いてなければ、足します。

これで、路線情報まわりの見直しは完了です。
次は複数のスジを引いたり、途中発着の対応をしたりしたいと思います。

2023-04-02

Excelでダイヤグラム：軸の設定

シートの初期化を整理します。
時間軸は全路線共通ですが、縦の罫線を引く範囲が路線に依存するので、路線の方に移して、残りの列幅設定はシート初期化の方に入れます。

Sub シート初期化(dataSheet As Worksheet)
    Sheets.Add After:=dataSheet
    Cells.Select
    With Selection.Font
        .Name = "Meiryo UI"
        .Size = 8
    End With
    Range("A1").Select
    Columns(1).ColumnWidth = 14
    cl = 2
    For hr = 4 To 25
        For i = 1 To 6
            Columns(cl).ColumnWidth = 5.66
            cl = cl + 1
        Next
    Next
End Sub

列の幅は、CSSのemのような、フォント高さに比例する値のようです。
Excelで列の境界をクリックすると表示されるので、試行錯誤で選びます。
設定は.ColumnWidthでいけます。

次は行の高さです。

Sub 路線設定(路線() As 路線情報, diag As Worksheet)
    rw = 1
    For i = 0 To UBound(路線)
        路線(i).ダイヤ行 = rw
        diag.Cells(rw, 1).Value = 路線(i).路線名
        rw = rw + 1
        For j = 1 To 路線(i).駅数
            diag.Cells(rw, 1).Value = 路線(i).駅名(j - 1)
            If j <> 1 Then
                diag.Rows(rw).RowHeight = 路線(i).駅間(j - 2) * 5
            End If
            diag.Range(Cells(rw, 1), Cells(rw, 6 * 22 + 1)).Borders(xlEdgeBottom).LineStyle = xlContinuous
            rw = rw + 1
        Next j
        For hr = 4 To 26
            cl = hr * 6 - 22
            diag.Cells(路線(i).ダイヤ行 + 1, cl).Value = hr
            diag.Cells(路線(i).ダイヤ行 + 1, cl).HorizontalAlignment = xlLeft
            diag.Range(diag.Cells(路線(i).ダイヤ行 + 1, cl), diag.Cells(rw - 1, cl)).Borders(xlEdgeLeft).LineStyle = xlContinuous
        Next
        rw = rw + 1
    Next i
End Sub

路線が複数の時の検証はまだです。おいおいやります。
RowHeightの単位はポイントのようです。
ここでは5を掛けてますが、好みで設定すればいいと思います。
セルの下線をデフォルト値で引いています。
1時間毎に数字を書いて線を引きます。