本文于2023年3月7日首发于本人同名公众号：Excel活学活用，敬请关注！

前天分享了一篇Excel VBA 自定义函数/取得颜色值/GetColor/ChatGPT来帮忙，由于时间匆忙，未及仔细推敲，今天发现还是有点问题，主要是颜色名称不全，还有就是觉得这么多颜色，用字典的方式会不会影响速度？有没有其他办法？

于是，今天花了一点时间，进一步完善了一下，重新分享给大家。

主要更新有：

1、颜色数量，相对较全

2、自定义函数代码修改：

（1）增加一张“颜色表"，存放颜色名称与值

（2）在代码中增加是否存在“颜色表“的判断，如果存在，则读取内容到数组，在数组中匹配颜色名称与值，否则，将一批颜色与名称的值加入字典，再从字典中查找匹配。如上图所示，两者的速度还是有点差距的。

主要代码如下：

在模块1：

Function ColorByName(colorName As String) As Long    Dim colorDict As Object    Dim ColortableExists As Boolean    Set colorDict = CreateObject("Scripting.Dictionary")    Dim Sht As Worksheet    Dim arrColor()    Dim iRow As Integer    For Each Sht In ThisWorkbook.Worksheets        If Sht.Name = "颜色表" Then             ColortableExists = True            Exit For        End If     Next    If ColortableExists Then        iRow = Sheets("颜色表").UsedRange.Rows.Count           arrColor = Sheets("颜色表").Range("A1:C" & iRow).Value            For i = 1 To iRow            If LCase(arrColor(i, 1)) = LCase(colorName) Then                ColorByName = arrColor(i, 3)                Exit For            End If            ColorByName = RGB(255, 255, 255)        Next    Else         '中文颜色名称        colorDict("爱丽丝蓝") = RGB(240, 248, 255)        colorDict("爱丽丝蓝色") = RGB(240, 248, 255)        colorDict("暗板岩蓝") = RGB(72, 61, 139)        colorDict("暗板岩蓝色") = RGB(72, 61, 139)        colorDict("暗淡灰") = RGB(105, 105, 105)        colorDict("暗淡灰色") = RGB(105, 105, 105)        colorDict("暗橄榄绿") = RGB(85, 107, 47)        colorDict("暗橄榄绿色") = RGB(85, 107, 47)        colorDict("暗海洋绿") = RGB(143, 188, 143)        colorDict("暗海洋绿色") = RGB(143, 188, 143)        colorDict("暗黄褐") = RGB(189, 183, 107)        colorDict("暗黄褐色") = RGB(189, 183, 107)        colorDict("暗灰蓝") = RGB(72, 61, 139)        ......        colorDict("Yellow") = RGB(255, 255, 0)        colorDict("YellowGreen") = RGB(154, 205, 50)        colorName = LCase(colorName)        For Each dictKey In colorDict.keys            If LCase(dictKey) = colorName Then                ColorValue = colorDict(dictKey)                Exit For            End If            ColorValue = RGB(255, 255, 255)         '如果没有则为白色        Next           ColorByName = ColorValue    End If End Function

这里有个对工作表是否存在的判断，可以单独列出来作为一个自定义函数来用，另外，加入字典的颜色以“整理”这张表为准，有新的颜色需要添加的，可以在“颜色表“中相应添加，注意第3列颜色值。

这份文件也可以作为一个颜色对照表来使用。

这个自定义函数也许没有太多的实际意义，你有一张颜色值对照表就可以了，按图索骥。但其中的一些写代码的方法与思路还是有点用处的。比如生成添加到字典的字符串，如果不用代码，几百条记录一条一条输入的话，效率太差，准确性也得不到保证，希望能对你有所帮助。

其他不多说了，请自行探索，有疑问与建议请留言。文件下载地址：

链接： 提取码：eodd

本文于2023年3月7日首发于本人同名公众号：Excel活学活用，敬请关注！