更快速地更改基于值的单元格颜色

我有vba代码来改变基于它的内容的单元格的颜色，目前我通过13000个单元格循环使用行和列索引为循环和select案例语句，但它需要大约30秒。 有谁知道更快的方法？

Answer 1

我怀疑从单元格中读取每个值占用了很大一部分时间。 尝试将数据读入数组，然后创build15个范围，每个颜色一个。 然后，只需在每个范围内用适当的颜色填充即可。

话虽如此，13,000个单元格颜色将需要一些时间。 我不能超过10秒。 如果你只需要做一次，那么30秒看起来并不那么糟糕？

Dim r As Long, c As Long, i As Long, rOff As Long, cOff As Long Dim data As Variant Dim dataRange As Range, cell As Range Dim colourRanges(14) As Range Dim colours(14) As Long 'Define the colours colours(0) = 255 colours(1) = 65535 colours(2) = 5296274 colours(3) = 12611584 colours(4) = 10498160 colours(5) = 49407 colours(6) = 192 colours(7) = 5287936 colours(8) = 15773696 colours(9) = 6299648 colours(10) = 5540756 colours(11) = 9803737 colours(12) = 13083058 colours(13) = 9486586 colours(14) = 14474738 'Define the target range With Sheet1 Set dataRange = .Range(.Range("A2"), _ .Cells(.Rows.Count, "A").End(xlUp)) _ .Resize(, 103) End With 'Calculate offsets from "A1" With dataRange rOff = .Cells(1).Row - 1 cOff = .Cells(1).Column - 1 End With 'Read data data = dataRange.Value2 'Test the data For r = 1 To UBound(data, 1) For c = 1 To UBound(data, 2) Select Case data(r, c) Case 1: i = 0 Case 2: i = 1 Case 3: i = 2 Case 4: i = 3 Case 5: i = 4 Case 6: i = 5 Case 7: i = 6 Case 8: i = 7 Case 9: i = 8 Case 10: i = 9 Case 11: i = 10 Case 12: i = 11 Case 13: i = 12 Case 14: i = 13 Case 15: i = 14 Case Else: i = -1 End Select 'Build the colour ranges If i <> -1 Then With Sheet1 Set cell = .Cells(r + rOff, c + cOff) If colourRanges(i) Is Nothing Then Set colourRanges(i) = cell Else Set colourRanges(i) = Union(colourRanges(i), cell) End If End With End If Next Next 'Colour the ranges Application.ScreenUpdating = False For i = 0 To 14 colourRanges(i).Interior.Color = colours(i) Next Application.ScreenUpdating = True 

Answer 2

这是我从另一个问题的一些示例代码。 您应该能够看到设置自动filter是多么容易，一旦过滤了您的标准，只需执行interior.colorindex即可为可见细胞设置任何颜色，然后更改下一个颜色漂洗和重复的标准。 我也build议在子开始时将计算转为手动，同时屏幕更新错误并使事件失效，然后在子集计算结束时自动返回到自动，并使其他两个事情再次成立。

 Private Sub CommandButton2_Click() Dim IMBacklogSh As Worksheet, logoffSh As Worksheet, deniedsh As Worksheet Set IMBacklogSh = ThisWorkbook.Worksheets("Backlog") Set logoffSh = ThisWorkbook.Worksheets("Claims Logged off") Set deniedsh = ThisWorkbook.Worksheets("Claims Denied") With IMBacklogSh If .AutoFilterMode Then .AutoFilterMode = False With .Cells(1, 1).CurrentRegion .AutoFilter field:=13, Criteria1:="#N/A" .AutoFilter field:=14, Criteria1:="C" With .Resize(.Rows.Count - 1, Columns.Count).Offset(1, 0) If CBool(Application.Subtotal(103, .Cells)) Then .Copy Destination:= _ logoffSh.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 'optionally delete the originals .EntireRow.Delete End If End With .AutoFilter field:=14, Criteria1:="<>C" With .Resize(.Rows.Count - 1, Columns.Count).Offset(1, 0) If CBool(Application.Subtotal(103, .Cells)) Then .Copy Destination:= _ deniedsh.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 'optionally delete the originals .EntireRow.Delete End If End With End With If .AutoFilterMode Then .AutoFilterMode = False End With 

结束小组

Answer 3

也许按照颜色代码标准进行sorting，然后更改范围，最后可能会翻转回原始序列。 按照不需要改变颜色的方式sorting，然后可以更快地退出…

Answer 4

为每种颜色使用一个范围。 把单元格放在一个vba数组中。 在一个循环中，您可以构build每个“颜色范围”，但不要着色范围。 在循环之后，每个“颜色范围”相应地接收其颜色。 瞧。 Basicaly