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語句以避免處理處理。）