あみだくじを作ろう：作業４ 縦罫を１列増やしてみる

さて、縦列を増やしてみよう。

Sub Macro1()

  Dim lRow    As Long
    With Range(Cells(3, 2), Cells(16, 3))
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeRight).Weight = xlThin
        .Borders(xlInsideVertical).Weight = xlThin
    End With
    Randomize
    For lRow = 3 To 15
        If Rnd > 0.5 Then
            Cells(lRow, 2).Borders(xlEdgeBottom).Weight = xlThin
        End If
    Next lRow    
End Sub

ただ、これだと増やした線に全く横罫が繋がらない。では次のようにしてはどうだろう？

Sub Macro1()
    Dim lRow    As Long
    With Range(Cells(3, 2), Cells(16, 3))
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeRight).Weight = xlThin
        .Borders(xlInsideVertical).Weight = xlThin
    End With
    Randomize
    For lRow = 3 To 15
        If Rnd > 0.5 Then
            Cells(lRow, 2).Borders(xlEdgeBottom).Weight = xlThin
        End If
    Next lRow
    For lRow = 3 To 15
        If Rnd > 0.5 Then
            Cells(lRow,3 ).Borders(xlEdgeBottom).Weight = xlThin
        End If
    Next lRow
    
End Sub

これでは、横罫が縦罫を貫いてしまう。そういうあみだくじはないので防止しよう。

Sub Macro1()
    Dim lRow    As Long
    With Range(Cells(3, 2), Cells(16, 3))
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeRight).Weight = xlThin
        .Borders(xlInsideVertical).Weight = xlThin
    End With
    Randomize
    For lRow = 3 To 15
        If Rnd > 0.5 Then
            Cells(lRow, 2).Borders(xlEdgeBottom).Weight = xlThin
        ElseIf Rnd > 0.5 Then
            Cells(lRow, 3).Borders(xlEdgeBottom).Weight = xlThin
        End If
    Next lRow    
End Sub

確かに線はいいが、なんだか右側の横罫が少ない。それもそのはず、左側の横罫がないときに横罫を引くかどうかの判定をやはり半分の確率で行っているからだ。
これだと見た目にショボい。また、今後、縦罫が増えたとき、このアルゴリズムでは対応しきれない。

次回はそのへんの解決をしていこう。