[Excel VBA]2 次元でキー割れしないといけなくなった

2020/04/18

2 次元でキー割れという表現が正しいかどうかはチョット判らないが、列ごとにデータを追加していって、キー割れが行われるとその行の次の行がスタートとなってまた列にデータを追加していくという処理が必要になったので、自宅で先に素振りしたメモ。

仕様

  • 1 ～ 10 の乱数を作成し、それを A 列～ J 列とする
  • 乱数に沿ったセルを着色する
  • 既に着色済みの時は、その次の行のセルを着色する
  • A 列～ J 列のいずれかが 5 で割り切れる行に到達したら、その次の行をスタートラインとして全列スタートする
  • 上記の処理を繰り返す

結果

コード

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sub RamdomStack()
    Dim ViewSheet As Worksheet
    Set ViewSheet = ThisWorkbook.Worksheets("Sheet1")

    ' Adjst
    With ViewSheet.Cells.Columns
        .Clear
        .ColumnWidth = 3
        .Font.Size = 8
        .HorizontalAlignment = xlCenter
    End With

    Dim Row As Long
    Dim Column As Integer
    Dim BreakPoint As Integer: BreakPoint = 1
    Const BreakCount As Integer = 5

    For i = 0 To 120
        Column = Int(Rnd * 10) + 1

        Row = BreakPoint
        If ViewSheet.Cells(Row, Column).Value <> "" Then
            Row = ViewSheet.Cells(Rows.Count, Column).End(xlUp).Row
            If ViewSheet.Cells(Row, Column).Value <> "" Then
                Row = Row + 1
            End If
        End If

        ' Decoration
        With ViewSheet.Cells(Row, Column)
            .Value = " "
            .Interior.Color = RGB(255, 200, 0)
        End With

        If (Row Mod BreakCount) = 0 And (Row + 1) >= BreakPoint Then
            BreakPoint = BreakPoint + BreakCount
        End If

        Call Sleep(300)
    Next

    Set ViewSheet = Nothing
End Sub

ProgrammingExcel, VBA

Posted by みやみや