Excelmacros不分配给一定范围的单元格的比例渐变颜色

我需要写一个这样的macros：我用一种紫色填充A1。 然后当我运行macros时，A2应该稍微轻一点，A3甚至更轻…等，直到A20是白色的。 但是这种颜色变化不应该是成比例的，即细胞边缘的颜色变化应该是下降的（例如，A2比A1更大程度地比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 

我尝试着引入一个整数variablesDim contrast as Integer到单元格“F5”，所以当我改变“F5”中的值时，颜色的边缘减less会下降。 但是这不起作用。 我如何改进代码？

Answer 1

下面的代码用下面的图片产生的tan函数代码：

在B栏中，您可以findT＆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上进行数据validation，其内容应在-1和1之间，然后更改您的代码，使得对比例不是整数，而是双精度（浮点数）：

 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将增加到更底部的白色，减less到-1将增加底部的黑色。 值不能超过-1或1，所以这些是你的单元格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 

可以了，好了！