VBA根据Cell Value的数量改变Cell的颜色

Question

我想根据我在另一个细胞中确定的细胞值来填充细胞。

例如，

• 如果我放A33="5"，则在C列中填写绿色5个单元格。
• 如果A34="10"，则同时在C列中填写另外10个单元格。

当我更改值时，我希望C列中单元格的数量和颜色会相应更改。

我分享了一张示例图片作为附件。如果可以使用VBA？

Answer 1

这适用于A~F列。

工作表事件代码

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Range("a33", "f36"), Target) Is Nothing Then
        setColor Target.Column
    End If
End Sub

模块代码

Sub setColor(col As Integer)
    Dim vDB, vColor
    Dim i As Integer, c As Integer, n As Integer

    vColor = Array(RGB(244, 185, 79), RGB(0, 180, 255), RGB(255, 54, 54), RGB(116, 211, 109))
    Range(Cells(1, col), Cells(32, col)).Interior.Color = RGB(36, 36, 36)
    vDB = Cells(33, col).Resize(4)
    For i = 1 To 4
        n = vDB(i, 1)
        c = c + n
        If IsEmpty(vDB(i, 1)) Then
        Else
            Cells(32, col).Offset(-c, 0).Resize(n).Interior.Color = vColor(i - 1)
        End If
    Next i

End Sub

Answer 2

Sub setColor(col As Integer)
    Dim vDB, vColor
    Dim i As Integer, c As Integer, n As Integer

    vColor = Array(RGB(244, 185, 79), RGB(0, 180, 255), RGB(255, 54, 54), RGB(116, 211, 109))
    Range(Cells(1, col), Cells(50, col)).Interior.Color = RGB(36, 36, 36)
    vDB = Cells(51, col).Resize(4)
    For i = 1 To 10
        n = vDB(i, 1)
        c = c + n
        If IsEmpty(vDB(i, 1)) Or c > 49 Then
        Else
            Cells(50, col).Offset(-c, 0).Resize(n).Interior.Color = vColor(i - 
        End If
    Next i

End Sub

Answer 3

Sub setColor（col as Integer）     昏暗的vDB，vColor     Dim i As Integer，c As Integer，n As Integer

vColor = Array(RGB(244, 185, 79), RGB(0, 180, 255), RGB(255, 54, 54), RGB(116, 211, 109))
Range(Cells(1, col), Cells(50, col)).Interior.Color = RGB(36, 36, 36)
vDB = Cells(51, col).Resize(4)
For i = 1 To 4 '<~~ your if your range is "a51,f56", then it sould be 4 
n = vDB(i, 1)
    c = c + n
    If IsEmpty(vDB(i, 1)) Or c > 49 Then
    Else
        Cells(50, col).Offset(-c, 0).Resize(n).Interior.Color = vColor(i - 1)
    End If
Next i

End Sub