あみだくじを作ろう：作業５ 横線を公平に引いてみる

横線を公平に引くように考えてみよう。

やり方はいろいろあるが、３本の縦罫に対して、２つの間隔。乱数で左右に振り分けてみる。

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   '0.5未満なら左
            Cells(lRow, 2).Borders(xlEdgeBottom).Weight = xlThin
        Else                'さもなくば右
            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   '0.5未満なら左
            If Rnd < 0.5 Then   '0.5未満なら線を引く
                Cells(lRow, 2).Borders(xlEdgeBottom).Weight = xlThin
            End If
        Else                'さもなくば右
            If Rnd < 0.5 Then   '0.5未満なら線を引く
                Cells(lRow, 3).Borders(xlEdgeBottom).Weight = xlThin
            End If
        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   '0.5未満なら左
            If Rnd < 0.8 Then
                Cells(lRow, 2).Borders(xlEdgeBottom).Weight = xlThin
            End If
        Else                'さもなくば右
            If Rnd < 0.8 Then
                Cells(lRow, 3).Borders(xlEdgeBottom).Weight = xlThin
            End If
        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    
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

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

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

あみだくじを作ろう：作業３ 横罫を適当に引いてみる

Sub Macro1()

  With Range(Cells(3, 2), Cells(16, 2))
    .Borders(xlEdgeLeft).Weight = xlThin
    .Borders(xlEdgeRight).Weight = xlThin
  End With

  Cells(5, 2).Borders(xlEdgeBottom).Weight = xlThin
  Cells(8, 2).Borders(xlEdgeBottom).Weight = xlThin
  Cells(10, 2).Borders(xlEdgeBottom).Weight = xlThin
  Cells(12, 2).Borders(xlEdgeBottom).Weight = xlThin
End Sub

このサンプルだと、決まった位置にしか線が引けない。適当に引いてみよう。
まず、縦線が３行目から１６行目なので、その間、つまり横線は４行目から１５行目に限定される。しかし、セルの下部に線を引いているので、開始は３行目とする。

Sub Macro1()

  Dim lRow    As Long

  With Range(Cells(3, 2), Cells(16, 2))
    .Borders(xlEdgeLeft).Weight = xlThin
    .Borders(xlEdgeRight).Weight = xlThin
  End With

  For lRow = 3 To 15
    Cells(lRow, 2).Borders(xlEdgeBottom).Weight = xlThin
  Next lRow 

End Sub

これで横罫は引けるが、全行引いている。引いたり引かなかったりを乱数で決めさせよう。

Sub Macro1()

    Dim lRow    As Long

    With Range(Cells(3, 2), Cells(16, 2))
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeRight).Weight = xlThin
    End With

    For lRow = 3 To 15
        If Rnd > 0.5 Then
            Cells(lRow, 2).Borders(xlEdgeBottom).Weight = xlThin
        End If
    Next lRow

End Sub

Rndは 0 ≦ n ＜ 1 の範囲の乱数を発生する。だから、だいたい半分くらいが目安で線が引かれる。
ただし、決まった乱数表を見に行くので、ＰＣを立ち上げなおしたら同じパターンが発生される、というように厳密には全くのランダムではない。それを防止するために

Sub Macro1()

    Dim lRow    As Long

    With Range(Cells(3, 2), Cells(16, 2))
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeRight).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

Randomize は、乱数発生のシード値（シード＝種なので、発生の際に参考にする値、と理解すればいいです。これが同じだと発生パターンが同じになります）を現在の時間（マシン時）にしますので、パターンがばらついてくれるようになる。より全くのランダムに近い状態で乱数を発生させることができるのだ。