Excel VBA - 极慢的单元格着色

Question

我有一系列我导入的.csv文件，其中包含需要应用于导入数据的颜色信息。色柱是冒号分隔的，并且数据是管道分隔：

:::::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表单包含定义的颜色的各种数据状态（丢失数据，错误的数据，过高，过低，等），通过导入的数据构建的小区联合，其中我最终适用于彩色化，所以我循环：

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语句以避免处理处理。）