Excel VBA でセルの背景色を設定する

Sub 背景色_set()
Dim clr(10) As Long


    clr(1) = RGB(255, 241, 209)
    clr(2) = RGB(231, 254, 255)
    clr(3) = RGB(254, 239, 232)
    clr(4) = RGB(214, 254, 225)
    clr(5) = RGB(240, 243, 233)
    clr(6) = RGB(245, 254, 202)
    clr(7) = RGB(250, 240, 240)
    clr(8) = RGB(240, 250, 220)
    clr(9) = RGB(238, 241, 231)
    clr(10) = RGB(255, 223, 249)
    
    Dim i, j As Long
    Dim buf As String
    
    buf = ";"
    
    For i = 1 To 10
        Randomize   '乱数系列初期化
        buf = buf + CStr(Int(8 * Rnd + 1)) + ";"    '1~8で乱数生成
    Next
    
    tmp = Split(buf, ";")
    
    buf = ";"
    For i = 1 To 18
        ii = i Mod 10
        If ii = 0 Then ii = 10
        For j = 1 To tmp(ii)
            buf = buf + "「あいう" & CStr(i) & "」sheetにああああが何個あります。[A2:C3],D~K,ANH~MJY,25~365" + ";"
        Next
    Next
    
    tmp = Split(buf, ";")
    
    ' ==============================================================
    
    clrno = 1
    For rw = 1 To 2
        clrno = 1
        For i = 1 To UBound(tmp)
            If i = 1 Then wsnm0 = Left(tmp(i), InStr(1, tmp(i), "」"))
            
            If wsnm0 <> Left(tmp(i), InStr(1, tmp(i), "」")) Then
                wsnm0 = Left(tmp(i), InStr(1, tmp(i), "」"))
                clrno = clrno + 1
                If clrno = 11 Then clrno = 1
            End If
            
            ActiveSheet.Cells(rw, i).Value = tmp(i)
            
            ActiveSheet.Cells(rw, i).Interior.Color = clr(clrno)
            
        Next
    Next
    
    MsgBox "end"
    
End Sub

薄い10色を選んで、それぞれが区別できるように順番配置する

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です