あみだくじを作ろう：作業７ 横線のばらつきを調整してみる２

今回は横線がスカスカにならないように調整する。

「５行をひとかたまりとして、その中で必ず横罫が１行は引かれるようにする」ことにしてみよう。そのひとかたまりの中で、５行の左右のどちらかに１行もなければ、補正処理として、線の塗り替えを行う。

Sub Macro1()

    Dim lRow    As Long
    Dim lRow2   As Long
    
    Dim iRightCnt   As Integer
    Dim iLeftCnt   As Integer

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

    Randomize

    For lRow = 3 To 17 Step 5
        
        iRightCnt = 0
        iLeftCnt = 0
        
        For lRow2 = lRow To lRow + 4    'lRow が 3 なら、3 ～ 7 の５つの間でループ
            If Rnd < 0.5 Then   '0.5未満なら左
                If Rnd < 0.8 Then   '0.8未満なら線を引く
                    Cells(lRow2, 2).Borders(xlEdgeBottom).Weight = xlThin
                    iLeftCnt = iLeftCnt + 1
                End If
            Else                'さもなくば右
                If Rnd < 0.8 Then   '0.8未満なら線を引く
                    Cells(lRow2, 3).Borders(xlEdgeBottom).Weight = xlThin
                    iRightCnt = iRightCnt + 1
                End If
            End If
        Next lRow2
        
    '補正処理
        If iRightCnt = 0 Or iLeftCnt = 0 Then
            Cells(lRow, 2).Borders(xlEdgeBottom).Weight = xlThin
            Cells(lRow, 3).Borders(xlEdgeBottom).LineStyle = xlNone
 
            Cells(lRow + 1, 2).Borders(xlEdgeBottom).LineStyle = xlNone
            Cells(lRow + 1, 3).Borders(xlEdgeBottom).Weight = xlThin
        End If
        
    Next lRow    
    
End Sub

線を引く際にはWeightで太さを指定すればいいが、消すときはLineStyleをxlNoneにする。

さて、次回は縦罫を増やしてみることにする。