Excel 宏，用于分配给一系列单元格的不成比例的渐变颜色

Question

我需要编写一个宏：我用紫色填充 A1。然后当我运行宏时，A2 应该更轻一点，A3 更轻......等等，直到 A20 是白色的。但是这种颜色变化不应该成比例，即“变得更亮”的单元格中的边缘颜色变化应该下降（使得 A2 比 A1 更亮，比 A3 比 A2 更亮）。 底线是：细胞应该变得更轻，但不成比例。

到目前为止，我有以下代码：

Sub Macro3()

Dim firstCell As Range 'the first cell, and the cell whose color will be used for all others.
Dim cellColor As Long 'the cell color that you will use, based on firstCell
Dim allCells As Range 'all cells in the column you want to color
Dim c As Long  'cell counter
Dim tintFactor As Double 'computed factor based on # of cells.
Dim contrast As Integer

Set firstCell = Range("A1")
cellColor = firstCell.Interior.Color
contrast = Range("F5").Value


Set allCells = Range("A1:A20")

For c = allCells.Cells.Count To 1 Step -1
    allCells(c).Interior.Color = cellColor
    allCells(c).Interior.TintAndShade = contrast * _
        (c - 1) / allCells.Cells.Count
  Next

End Sub

我尝试将整数变量Dim contrast as Integer 引入单元格“F5”，这样当我更改“F5”中的值时，颜色的边际减少会下降。但这不起作用。如何改进代码？

Answer 1

下面是带有tan函数的代码，结果如下图：

在 B 列中，您会发现 T&S 颜色参数之间的差异。

Sub Macro3_proposal()

Dim firstCell As Range 'the first cell, and the cell whose color will be used for all others.
Dim cellColor As Long 'the cell color that you will use, based on firstCell
Dim allCells As Range 'all cells in the column you want to color
Dim c As Long  'cell counter
Dim tintFactor As Double 'computed factor based on # of cells.
Dim contrast As Integer

Set firstCell = Range("A1")
cellColor = firstCell.Interior.Color
contrast = Range("F5").Value


Set allCells = Range("A1:A20")

Dim allCellsCount!
allCellsCount = allCells.Cells.Count - 1
For c = 1 To allCellsCount 
    allCells(c + 1).Interior.Color = cellColor

    allCells(c + 1).Value = contrast * (Tan(c / allCellsCount) / Tan(1))
    allCells(c + 1).Interior.TintAndShade = contrast * (Tan(c / allCellsCount) / Tan(1))
  Next

End Sub

Answer 2

在单元格 F5 上进行数据验证，确认其内容应介于 -1 和 1 之间，然后更改代码，使对比度不是整数，而是 Double（浮点）：

Sub Macro3()

    Dim firstCell As Range 'the first cell, and the cell whose color will be used for all others.
    Dim cellColor As Long 'the cell color that you will use, based on firstCell
    Dim allCells As Range 'all cells in the column you want to color
    Dim c As Long  'cell counter
    Dim tintFactor As Double 'computed factor based on # of cells.
    Dim contrast As Double 'double precision factor for changing the contrast 0= none higher is more

    Set firstCell = Range("A1")
    cellColor = firstCell.Interior.Color
    contrast = Range("F5").Value


    Set allCells = Range("A1:A20")

    For c = allCells.Cells.Count To 1 Step -1
        allCells(c).Interior.Color = cellColor
        allCells(c).Interior.TintAndShade = _
            contrast * (c - 1) / (allCells.Cells.Count -1)

    Next

End Sub

值 0 是所有相同的颜色，最大为 1 将增加底部的白色，减少到 -1 将增加底部的黑色。该值不能超过 -1 或 1，因此这些是您的 Cell F5 限制。

在自动更新您漂亮的颜色丝带旁边，将Worksheet_Change 子添加到您的 VBA：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("F5")) Is Nothing Then
        Call Macro3
    End If
End Sub

一切就绪！