Question

我知道有很多问题的题目与我的题目几乎相同，但是如果您进一步阅读，您会明白我的问题为何与众不同。大多数问题都提出这样的问题：如果值是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 。因此，在上面的示例中，第一列和第三列（都具有2017.09）应使用一种颜色，第二列和第四列（都具有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中做了完全一样的事情。我以前从未使用过VBA，所以我很难使用它：

const colors = [
	'#FF6633', '#FFB399', '#FF33FF', '#FFFF99', '#00B3E6', 
	'#E6B333', '#3366E6', '#999966', '#99FF99', '#B34D4D',
	'#80B300', '#809900', '#E6B3B3', '#6680B3', '#66991A', 
  	'#FF99E6', '#CCFF1A', '#FF1A66', '#E6331A', '#33FFCC',
  	'#66994D', '#B366CC', '#4D8000', '#B33300', '#CC80CC', 
 	'#66664D', '#991AFF', '#E666FF', '#4DB3FF', '#1AB399',
  	'#E666B3', '#33991A', '#CC9999', '#B3B31A', '#00E680', 
  	'#4D8066', '#809980', '#E6FF80', '#1AFF33', '#999933',
  	'#FF3380', '#CCCC00', '#66E64D', '#4D80CC', '#9900B3', 
  	'#E64D66', '#4DB380', '#FF4D4D', '#99E6E6', '#6666FF'
];
const used = {};

function getColor(key) {
  	used[key] = used[key] || colors.shift();
  	return used[key];
}

function setHeaderColor() {
	const mainTable = document.getElementById('main-table');
	const headerRow = document.querySelectorAll('#main-table tr:first-child th');
	const test = [];																// Holds first 7 chars and background color of each column header

	// Extract first 7 characters from column header name
	for (let i = 0; i < headerRow.length; i++) {
		test.push({
			version: headerRow[i].innerHTML.substring(0, 7),
			color: headerRow[i].style.backgroundColor || null
		});
	}

	for (let i = 1; i < test.length; i++) {
			test[i].color = getColor(test[i].version);
	}

	for (let i = 0; i < headerRow.length; i++) {
		headerRow[i].style.backgroundColor = test[i].color;
	}
}

document.addEventListener('DOMContentLoaded', setHeaderColor);

<link rel="stylesheet" href="https://www.w3schools.com/w3css/4/w3.css">

<table class="w3-table-all" id="main-table">
  <tr>
    <th class="w3-center"> Name</th>
    <th class="w3-center">2017.10-T-2018_08_30 ms_201709.</th>
    <th class="w3-center">2017.09-T-2018_08_30 ms_201709.</th>
    <th class="w3-center">2017.10-T-2018_08_30 ms_201709</th>
    <th class="w3-center">2017.09-T-2018_08_30 ms_201709</th>
    <th class="w3-center">2017.08-T-2018_08_30 ms_201709</th>
  </tr>
</table>

Answer 1

类似这样的东西：

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中，请将Range("A1:E1")更改为：

Range("A1",cells(1,Columns.Count).end(XlToLeft))

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

Intersect(Rows(1),Activesheet.Usedrange)

请注意，所有这些都假设您正在使用活动表。考虑添加工作簿和工作表引用以避免错误。

多页版本：

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

基于值的颜色单元标题（值未知）

1 个答案: