办公表格颜色排序技巧图解(Excel VBA 随机生成颜色/设置单元格颜色)

本文于2023年5月22日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！

☆本期内容概要☆

大家好，我是冷水泡茶，关于颜色的话题，前期我们分享过【更新：Excel VBA 自定义函数/根据颜色名称中英文取得颜色值】，今天中午我准备出门散步时，把电脑锁定，看到屏幕保护程序是随机变色，我就突发奇想，我用VBA能不能实现随机变色呢？感觉不是太难，回来后就动手做起来。

需求描述：

1、点一下按钮，随机生成RGB颜色值。

2、把该颜色值设置到一个或一组单元格里，并把该颜色值记下来，供选择。

3、设定一个频率，自动生成一系列颜色值。

最终结果：

点一次“换色”，增加一个随机颜色。

点“自动换色”，则按照下面的数量，间隔秒，生成随机色。

如果点“停止”，在间隔秒>0.5的情况下，会停止运行。（这里时间间隔为整数秒，小于等于0.5则舍入为0，这是我根据运行情况的判断）

点“清除”则清除H列，I列的颜色信息。

下面我们看代码：

1、G列的按钮，从上到下分别是：CmdChangeColor、CmdAutoChangeColor、CmdStop、CmdClear

Private Sub CmdAutoChangeColor_Click() KeepGoing = True Q = 0 Interval = Range("G4").Value MaxQ = Int(Range("G3").Value) Range("H2:I" & UsedRange.Rows.Count).Clear Call AutoChangeColorEnd SubPrivateSubCmdCahngeColor_Click() Call ChangeColorEnd SubPrivateSubCmdClear_Click() Range("H2:I" & UsedRange.Rows.Count).ClearEnd SubPrivateSubCmdStop_Click() KeepGoing = FALSEEndSub

代码解析：

在“自动换色”里，我们将变量KeepGoing赋值为TRUE，Q赋值为0，InterVal为间隔秒，MaxQ为最大数量。在“停止”里，我们将变量KeepGoing赋值为FALSE。

2、模块1：

Public KeepGoing As BooleanPublic Q As IntegerPublic Interval As SinglePublic MaxQ As IntegerSub ChangeColor() Dim r As Integer, g As Integer, b As Integer Dim currCell As Range Randomize timer r = Int(255 * Rnd) g = Int(255 * Rnd) b = Int(255 * Rnd) Sheet1.Activate With ActiveSheet .Range("A1:E10").Clear .Range("A1:E10").Interior.color = RGB(r, g, b) Set currCell = .Range("I" & .Rows.Count).End(xlUp).offset(1) currCell.Clear currCell.Value = "RGB(" & r & ", " & g & "," & b & ")" currCell.Interior.color = RGB(r, g, b) If GetContrastColor(currCell.Interior.color) = vbBlack Then currCell.Font.color = vbBlack Else currCell.Font.color = vbWhite End If currCell.Offset(0, -1).Interior.color = RGB(r, g, b) End With Q = Q 1EndSubSubAutoChangeColor() '设置初始运行时间间隔（以秒为单位） Dim timeInterval As Date If KeepGoing And Q < MaxQ Then timeInterval = Now TimeSerial(0, 0, Interval) ' 每隔?秒运行一次，可根据需要修改间隔时间 '调用需要循环运行的子过程 Call ChangeColor '设置下一次运行的时间间隔 Application.OnTime timeInterval, "AutoChangeColor" Else Exit Sub End IfEnd SubFunction GetContrastColor(ByVal color As Long) As Long ' 根据背景色获取对比的前景色（黑色或白色） ' 使用 YIQ 颜色空间算法 Dim r As Long, g As Long, b As Long Dim y As Double r = color Mod 256 g = (color 256) Mod 256 b = (color 65536) Mod 256 y = 0.299 * r 0.587 * g 0.114 * b If y >= 128 Then GetContrastColor = vbBlack Else GetContrastColor = vbWhite End IfEndFunction

代码解析：

（1）首先，定义几个公共变量，前面提到过。

（2）ChangeColor过程，通过Rnd函数生成0~1的随机数，让它乘上255再取整，就得到一个0~255的随机数，正好是RGB颜色的R/G/B的值。

（3）取得RGB的值以后，据以设置“A1:E10”单元格的背景色；同时把颜色值顺序写入I列，通过range().End（xlup）的方法取得最后一个非空单元格，再使用offset的方法得到下面一个空单元格currCell，把当前颜色值写入currCell。

（4）把currCell同样设置当前颜色为背景色，为了避免字体颜色与背景色相近造成显示不清楚，用了一个自定义函数GetContrastColor来取得一个高对比度的颜色。简单来说，如果背景色是深色，则字体为白色，如果背景色为浅色，则字体为黑色。这个函数是ChatGPT给的。

（5）AutoChangeColor过程，这也是ChatGPT给的，它给是的无限运行的，我加了一个IF判断，如果点了“停止”或者是达到了最大数量，则退出过程。

（6）在每次生成颜色后，设置相关单元格颜色前，都加了一句.Clear，用来清除单元格格式与内容。原因是如果数量设得过大，会报错：“不同的单元格格式太多！”。

今天的内容就这么多，后面会继续，敬请关注！还请大家多多点赞、留言、分享，谢谢大家，我们下期再会。

☆猜你喜欢☆

【重磅】Excel VBA 应用分享/中医诊所收费系统/Excel ListBox版

Excel VBA 动态添加控件/学生成绩筛选

Excel VBA 这样酷炫的日期控件，你不想要吗？

Excel 公式函数/数据透视表/固定资产折旧计提表！

Excel VBA 自定义函数/数组字段定位/数组字段排序

Excel 功能/公式函数/VBA/多种姿势处理重复值

Excel VBA 最简单的收发存登记系统

Excel 公式函数/查找函数之LOOKUP

Excel VBA 文件批量改名

Excel 公式函数/数据验证/动态下拉列表

Excel VBA 输入逐步提示/TextBox ListBox

Excel 基础功能【数据验证】，你会怎么用？

本文于2023年5月22日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！