Excel VBA – 非常慢的细胞着色

我正在导入一系列.csv文件，其中包含我需要应用到导入的数据的颜色信息。 颜色列以冒号分隔，数据以pipe道分隔：

:::::65535::|ADAM 14-22TGH|CHERRY|twu|Diesel Fuel (RIG)|Fuel|| ::::14994616:::|MARCO 41-12G|CRYSTAL|HVA|Diesel Fuel (RIG)|Rig Fuel|gal us| :::65535:65535:65535:65535:|MARCO 41-12G|CRYSTAL||||| 

Excel工作表包含各种数据状态的定义颜色（缺失数据，错误数据，太高，太低等），因此我通过导入的数据循环构build单元联合，最终将彩色化应用于：

 Dim ds As Worksheet Dim i As Long, j As Long, k As Long Dim iUsedCol As Long, iUsedRow As Long, clrRequired As Long, color as Long Dim rngRequired As Range Dim colorMap As Variant Dim colors() As String clrRequired = CLng(GetSetting("Failed Required Field Check")) ' Get the values of the color column iusedRow = ds.UsedRange.Rows.Count colorMap = Range(ds.Cells(1, 1), Cells(iUsedRow, 1)).Value ' Delete the color map column ds.Columns(1).EntireColumn.Delete ' Skip the first two rows For i = 3 To iusedRow colors = Split(colorMap(i, 1), ":") ' Offset by one column since we're deleting column 1 after For j = 2 To UBound(colors) + 1 If colors(j - 1) = "" Then Else color = CLng(colors(j - 1)) ' Required If color = clrRequired Then If rngRequired Is Nothing Then Set rngRequired = ds.Cells(i, j) Else Set rngRequired = Application.Union(rngRequired, ds.Cells(i, j)) End If End If End If Next j Next i ' Set the colors If Not rngRequired Is Nothing Then rngRequired.Interior.color = clrRequired End If 

为了简单起见，我除去了其他三种相同的检查其他颜色，但这是模式。 取决于数据，可以是50行或12000行，根据正在检查的内容而有不同的列。 我有一个需要20多分钟才能运行的报告，当我删除这个着色代码时，它在大约10秒内完成。

另外这里是我在运行代码时禁用的内容：

• 计算
• CancelKey
• PrintCommunication
• ScreenUpdating
• 活动
• 状态栏
• 警报

Answer 1

试试下面的代码：

 Dim ds As Worksheet Dim i As Long, j As Long, k As Long Dim iUsedCol As Long, iUsedRow As Long, clrRequired As Long, color As Long '... 'Set ds = ..... '... iUsedRow = ds.UsedRange.Rows.Count ' Skip the first two rows For i = 3 To iUsedRow colors = Split(ds.Cells(i, 1).Value, ":") ' Offset by one column since we're deleting column 1 after For j = 2 To UBound(colors) + 1 If colors(j - 1) <> "" Then ds.Cells(i, j).Interior.color = CLng(colors(j - 1)) End If Next j Next i ' Delete the color map column ds.Columns(1).EntireColumn.Delete 

这将处理一个循环中的所有颜色。 （这可能是一个问题，如果你只是试图设置某些颜色，如你的GetSetting调用所定义的那样，如果是这样，你可能需要包含一个If语句以避免处理，如果指定的颜色不是你想要的颜色之一处理。）