如何强制excel单元格以指数方式改变颜色？

Posted 2023-02-23

【中文标题】如何强制excel单元格以指数方式改变颜色？

【英文标题】：How to force excel cells to change colors EXPONENTIALLY?

【发布时间】：2013-04-22 16:20:09

【问题描述】：

我需要编写一个宏：我用黑色填充 A1。然后当我运行宏时，A2 应该更轻一点，A3 更轻......等等，直到 A20 是白色的。 “F5”单元格值应控制梯度指数的程度。 当前代码按比例更改颜色。当我更改“F5”中的值（例如从 1 到 0.7）时，会发生什么，这 20 个单元格（“A1:A20”）中的所有单元格都变暗了。最后一个单元格 A20 不再是白色的了。

但是，我需要我的第一个单元格“A1”为黑色，最后一个单元格“A20”为白色无论如何......而且，单元格的颜色分布应该是EXPONENTIAL，即 A1 和 A2 之间的暗度差应该是 A3 和 A2 之间的暗度差的两倍（如果“F5”==2）等等...

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

我不知道，我应该在上面实现什么功能，以便 颜色的变化将是指数级的，因为我在“F5”中更改了变量contrast 的值？ // 与

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

【问题讨论】：

您是否需要在 B 列中提供准确的值或类似的值？

@KazJaw 我只需要类似的。我只是试图展示一个可以描述我需要的示例。

【参考方案1】：

您不能同时拥有“下一个单元格是白色的两倍”和“第一个单元格是黑色，最后一个单元格是白色”。您正在寻找的是一种称为“伽玛函数”的东西 - 数字从 0 到 255 的缩放程度，其中它们变轻的速率取决于一个因素（有时称为伽玛）。

在它的基本形式中，你可以使用类似的东西：

contrast = ((cellNum-1)/(numCells-1))^gamma

现在，如果您的 gamma 为 1，则缩放将是线性的。当 gamma > 1 时，最后几个细胞的强度会增加得更快。小于1时，前几个单元格变化很快。

我在上面假设 cellNum 从 1 到 20，而 numCells 是 20。这个对比度值，在你使用的 .TintAndShade 表达式中，应该会给你你的效果寻找。 gamma 不需要是整数，但如果它是 1，这会给你带来奇怪的结果（我想全白）。

顺便说一下 - 将你的 macro3 重命名为更合理的名称 (adjustContrast)，并使用 F5 的值作为参数调用它：

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("F5")) Is Nothing Then
    adjustContrast Target.Value
  End If
End Sub

和

Sub adjustContrast(gamma)
  ... etc

由于从您的评论中可以清楚地看出我在原始帖子中不够明确，这里是完整的代码，以及它给我的结果。注意 - 这是演示更改 gamma 对显示器的影响的代码，而不是您要使用的确切代码（例如，我循环四列并有四个不同的 gamma 值）：

Sub applyGamma()
Dim ii, jj As Integer
Dim contrast As Double
Dim cellColor, fontColor, fontInvColor As Long
Dim allCells As Range
Dim gamma As Double

On Error GoTo recovery
Application.ScreenUpdating = False
Set allCells = [A2:A21]

' default formatting taken from cell A1
cellColor = [A1].Interior.Color
fontColor = [A1].Font.Color
fontInvColor = 16777215 - fontColor ' use the "inverse" color... sloppy way to always see the numbers

For jj = 1 To 4
  Set allCells = allCells.Offset(0, 1)
  gamma = Cells(1, jj + 1).Value ' pick gamma from the column header
  For ii = 1 To 20 ' loop over all the cells
    contrast = ((ii - 1) / 19) ^ gamma ' pick the contrast for this cell
    allCells.Cells(ii, 1).Interior.Color = cellColor
    allCells(ii, 1).Interior.TintAndShade = contrast
    If contrast > 0.5 Then allCells.Cells(ii, 1).Font.Color = fontInvColor Else allCells(ii, 1).Font.Color = fontColor

  Next ii
  ' repeat for next column:
Next jj

recovery:
Application.ScreenUpdating = True

End Sub

在我运行代码之前，我的屏幕如下所示（单元格中的值是针对给定伽玛计算的对比度值）：

运行后是这样的：

如您所见，我添加了一个额外的“功能”：更改了字体颜色以保持可见性。当然，这假设“模板单元格”（在我的例子中是A1）在字体和填充颜色之间具有良好的对比度。

【讨论】：

为了表达我的观点并更清楚地描述它，我夸大了两倍的颜色。我凭直觉知道我的contrast 公式中应该有一些^ 指数。但是，我不知道应该如何更正我的代码。我按照您的建议尝试了gamma，但没有得到任何积极的结果。您能否使用任何测试功能更正我的代码，使其正常工作？

@Buras - 我用一个完整的工作宏和几个屏幕截图扩展了我的答案，这样你就可以准确地看到发生了什么。

谢谢。很详细的回答

【参考方案2】：

要让它以指数方式工作，您可以尝试使用以下结果的逻辑：

与您的代码相比，以下代码略有变化：

Sub Macro3_proposal_revers()

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("B1")
cellColor = firstCell.Interior.Color
    contrast = Range("F5").Value

Set allCells = Range("B1:B20")

Dim allCellsCount!
allCellsCount = allCells.Cells.Count - 1
Dim newContrast As Double
For c = 1 To allCells.Cells.Count - 1

    allCells(c + 1).Interior.Color = cellColor
    'var 1
    newContrast = (1 - 0.9 ^ (c * (1 + (c / allCellsCount))) * contrast)

    allCells(c + 1).Interior.TintAndShade = newContrast

    'control value- to delete
    allCells(c + 1).Offset(0, 1).Value = allCells(c + 1).Interior.TintAndShade
  Next

End Sub

什么是重要的-看看这一行：

    newContrast = (1 - 0.9 ^ (c * (1 + (c / allCellsCount))) * contrast)

你可以做任何你想做的事，例如。更改：(1 + (c / allCellsCount)) 变为 1 到 2 之间的东西以了解逻辑方式。一般来说，你可以通过操纵这一行来调整阴影变化的速度，尤其是用这部分代码来操纵：(c * (1 + (c / allCellsCount))