Excel 根据事先未知的值为单元格标题着色

也有类似的问题，但他们会问这样的问题：如果值是100色红色，200色绿色

我的情况-单元格的值事先未知，因此没有匹配或比较的模式

我的目标：

我想根据前7个字符为每列中的第一个单元格上色

例如，这些是示例单元格：

2017.09--T-2018_08_30   2017.10--T-2018_08_30   2017.09--T-2018_08_30   2017.10--T-2018_08_30   2017.08--T-2018_08_30 

前7个字符是yyyy.mm。第1列和第3列（均为2017.09）应为一种颜色，第2列和第4列（均为2017.10）应为不同颜色，最后一列（2017.08）也应为不同颜色

我希望从一系列颜色中提取颜色：

Dim colors() as String: colors = Array("RGB(255,99,71)", "RGB(255,127,80)", "RGB(205,92,92)", "RGB(240,128,128)", "RGB(233,150,122)", "RGB(250,128,114)", "RGB(255,160,122)", "RGB(255,69,0)", "RGB(255,140,0)", "RGB(255,165,0)")

所以我可以可视化我的目标-我用JavaScript做了同样的事情

const colors=[
#FF6633'、#FFB399'、#FF33FF'、#FFFF99'、#00B3E6'，
#E6B333'、#3366E6'、#999666'、#99FF99'、#b34dD'，
"80B300","809900","E6B3B3","6680B3","66991A",，
"FF99E6","CCFF1A","FF1A66","E633A","33FFCC"，
"66994D","B366CC","4D8000","B33300","CC80CC",，
"66664D","991AFF","E666FF","4DB3FF","1AB399",，
"E666B3","33991A","CC9999","b3631a","00E680",，
"4D8066","809980","E6FF80","1AF33","999933",，
"FF3380","CCCC00","66E64D","4D80CC","9900B3",，
#E64D66'、#4DB380'、#FF4D4D'、#99E6E6'、#6666FF'
];
const used={}；
函数getColor（键）{
used[key]=used[key]| | colors.shift（）；
返回使用过的[键]；
}
函数setHeaderColor（）{
const mainTable=document.getElementById（'main-table'）；
const headerRow=document.querySelectorAll（“#主表tr:first child th”）；
const test=[]；//保存每个列标题的前7个字符和背景色
//从列标题名称中提取前7个字符
for（设i=0；i

名称
2017.10-T-2018_08_30 ms_201709。
2017.09-T-2018_08_30 ms_201709。
2017.10-T-2018_08_30 ms_201709
2017.09-T-2018_08_30 ms_201709
2017.08-T-2018_08_30 ms_201709
类似这样的内容：

Sub color_header()
    Dim colors(): colors = Array(RGB(255, 99, 71), RGB(255, 127, 80), RGB(205, 92, 92), RGB(240, 128, 128), RGB(233, 150, 122), RGB(250, 128, 114), RGB(255, 160, 122), RGB(255, 69, 0), RGB(255, 140, 0), RGB(255, 165, 0))
    Dim a As Integer: a = 0
    Dim D1 As Object: Set D1 = CreateObject("scripting.dictionary")
    Dim R1 As Range: Set R1 = Range("A1:E1") 'This is your header area
    Dim R0 As Range

    For Each R0 In R1
        If Not D1.exists(Left(R0, 7)) Then
            D1.Add Left(R0, 7), a
            R0.Interior.Color = colors(a)
            a = a + 1
        Else
            R0.Interior.Color = colors(D1(Left(R0, 7)))
        End If
    Next R0
End Sub


缩小动态范围的几种方法：

如果您知道第一个数据在
A1
中，请将
范围（“A1:E1”）
更改为：

Range（“A1”，单元格（1，Columns.Count）.end（XlToLeft））

如果您只知道数据在第1行，您可以尝试：

Intersect（行（1），Activesheet.Usedrange）

请注意，这都是假设您正在处理activesheet。考虑添加工作簿和工作表引用以避免错误。

多页版本：

Sub color_header()
    Dim colors(): colors = Array(RGB(255, 99, 71), RGB(255, 127, 80), RGB(205, 92, 92), RGB(240, 128, 128), RGB(233, 150, 122), RGB(250, 128, 114), RGB(255, 160, 122), RGB(255, 69, 0), RGB(255, 140, 0), RGB(255, 165, 0))
    Dim a As Integer: a = 0
    Dim D1 As Object: Set D1 = CreateObject("scripting.dictionary")
    Dim Ws As Worksheet
    Dim R1 As Range
    Dim R0 As Range

    For Each Ws In ActiveWorkbook.Sheets
        Set R1 = Ws.Range("A1", Ws.Cells(1, Ws.Columns.Count).End(xlToLeft))
        For Each R0 In R1
            If Not D1.exists(Left(R0, 7)) Then
                D1.Add Left(R0, 7), a
                R0.Interior.Color = colors(a)
                a = a + 1
            Else
                R0.Interior.Color = colors(D1(Left(R0, 7)))
            End If
        Next R0
    Next Ws
End Sub

谢谢我明天会检查它，肯定会更新它是否工作良好。我刚刚检查过，它工作正常。谢谢！但是，有没有一种方法可以让我动态获取
R1
？例如，现在它被设置为
“A1:E1”
。如果我事先不知道哪些列有数据，该怎么办？我使用了
Intersect
解决方案，它起了作用，但问题是我需要从B-B1列开始。Intersect start from first column-A。我喜欢使用
Range
编辑的第一个解决方案，但我得到一个错误：
对象不支持此属性/方法
。我还试图以某种方式将其应用于工作簿中的所有工作表。每当我调用这个函数时，我都在MyBook.Worksheets中的每个ws的
内部调用它。。。下一步ws
，但它不会应用于所有图纸。有什么帮助吗？谢谢，
Intersect
不一定是从A列开始的，但我同意有时要用它来获得正确的行为是很棘手的。我修正了第一个选项，只是一个输入错误。我将编辑多张工作表。将A1更改为B1，因为这似乎是您的起点，并注意颜色编码在工作表中保持一致，因此，如果您有比存储的颜色更多的不同代码，请小心。