Question

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

:::::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表包含各种数据状态的定义颜色（缺少数据，错误数据，太高，太低等），所以我遍历导入的数据构建一个单元联合，我最终将颜色应用于：< / p>

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语句，以避免在指定的颜色不是您想要的颜色之一时进行处理处理。）

Excel VBA - 非常慢的细胞着色

1 个答案: