Question

我有vba代码来改变基于其当前内容的单元格的颜色我使用行和列索引的循环和一个选择案例语句单独循环遍历13000个单元格，但它需要大约30秒。有谁知道更快的方式？

Answer 1

这是我从另一个问题得到的一些示例代码。您应该能够看到设置自动过滤器是多么容易，一旦按照您的标准进行过滤，只需对要为可见单元格设置的颜色执行interior.colorindex，然后更改下一次颜色冲洗和重复的标准。我还建议在sub的开头将计算变为手动，同时使用screenupdating false并启用事件false，然后在子集计算结束时将其重新设置为自动，并使其他两个事情再次成立。

<br>

End Sub

Answer 2

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

话虽如此，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 3

或许可以按照颜色代码的标准进行排序，然后改变范围，最后可能会重新回到原始序列。对它进行排序，使得不需要改变颜色的那些出现在最后..然后你可以更快地退出......

Answer 4

为每种颜色使用范围。将单元格放在vba数组中。在循环中，您可以构建每个颜色范围＆＃39;但是不要为范围着色。在循环之后，每个颜色范围都是＆＃39;相应地接收它的颜色。瞧。 Basicaly

更快地根据值更改单元格颜色

4 个答案: