Question

我有一张约300行和30列数字的工作表。由于处理SelectionChange事件，我需要绘制单元格。性能是至关重要的可用性。

第一种方法是为我要突出显示的每个单元格获取一个Range对象：

For x = 1 To 30: For y = 1 To lastNonemptyRow
    If someClause(CInt(Cells(rowIdx, colIdx).Value)) Then
        Range(Cells(rowIdx, colIdx).Value).Interior.Color = Rgb(255, 0, 0)
    End If
Next y: Next x

即使禁用了ScreenUpdating，这种方式也相当慢。

第二种方法是使用地址集创建字符串：

addressesToHighlight = ""
For x = 1 To 30: For y = 1 To lastNonemptyRow
    If someClause(CInt(Cells(rowIdx, colIdx).Value)) Then
        addressesToHighlight = addressesToHighlight & Cells(rowIdx, colIdx).Address & ", "
    End If
Next y: Next x
Range(addressesToHighlight).Interior.Color = Rgb(255, 0, 0)

当要突出显示42个或更多单元格时，这种方法会产生错误。

第三种方法是创建一个范围作为两个范围的合并，这两个范围是先前累积的单元格和当前单元格：

Set resultRange = Nothing
For x = 1 To 30: For y = 1 To lastNonemptyRow
    If someClause(CInt(Cells(rowIdx, colIdx).Value)) Then
        If resultRange is Nothing then
            Set resultRange = Range(Cells(rowIdx, colIdx))
        Else
            Set resultRange = Union(resultRange, Range(Cells(rowIdx, colIdx)))
        End if
    End If
Next y: Next x
resultRange.Interior.Color = RGB(255, 0, 0)

这种方式相当快，但是在执行1000个单元之后，其执行时间呈指数增长：1.5秒内突出显示1000个单元，而8秒内突出显示2000个单元。

指定和突出显示任意1000..10000个单元格的最快方法是什么？

Answer 1

这是您要执行的操作。没有进一步的信息，您将使用哪种子句？我不得不自己想办法，我雇用了许多（全部？）用于加速程序的技术。 10次执行的平均运行时间为0.2254秒，绘制了1万个单元格

Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Sub newnew()
Dim started As Long
Dim ws As Worksheet
Dim paintRng As String
Dim rng As Range
Dim ColumnCount As Long
Dim RowCount As Long
Dim arrRng() As Variant
Dim wsTwo As Worksheet
Dim rngTwo As Range
Dim colNum As Long
Dim rowNum As Long
Dim ended As Long

    started = timeGetTime

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With

    started = timeGetTime

    Set ws = Sheets("Sheet1")

    ws.DisplayPageBreaks = False

    paintRng = "A1:J1000"

    Set rng = ws.Range(paintRng)
    ColumnCount = rng.Columns.Count
    RowCount = rng.Rows.Count

    ReDim arrRng(1 To RowCount, 1 To ColumnCount)
    arrRng = rng

    Debug.Print ColumnCount
    Debug.Print RowCount


    Set ws = Nothing
    Set rng = Nothing

    Set wsTwo = Sheets("Sheet2")
    wsTwo.DisplayPageBreaks = False

    Set rngTwo = wsTwo.Range(paintRng)

    With rngTwo
        For colNum = 1 To ColumnCount
            For rowNum = 1 To RowCount
                If arrRng(rowNum, colNum) = 1 Then
                    .Cells(rowNum, colNum).Interior.Color = RGB(255, 0, 0)
                ElseIf arrRng(rowNum, colNum) = 2 Then
                    .Cells(rowNum, colNum).Interior.Color = RGB(125, 0, 0)
                ElseIf arrRng(rowNum, colNum) = 3 Then
                    .Cells(rowNum, colNum).Interior.Color = RGB(0, 255, 0)
                ElseIf arrRng(rowNum, colNum) = 4 Then
                    .Cells(rowNum, colNum).Interior.Color = RGB(0, 0, 255)
                ElseIf arrRng(rowNum, colNum) = 5 Then
                    .Cells(rowNum, colNum).Interior.Color = RGB(125, 125, 0)
                ElseIf arrRng(rowNum, colNum) = 6 Then
                    .Cells(rowNum, colNum).Interior.Color = RGB(125, 0, 125)
                ElseIf arrRng(rowNum, colNum) = 7 Then
                    .Cells(rowNum, colNum).Interior.Color = RGB(75, 75, 200)
                ElseIf arrRng(rowNum, colNum) = 8 Then
                    .Cells(rowNum, colNum).Interior.Color = RGB(50, 125, 255)
                End If
            Next rowNum
        Next colNum
    End With

    Set wsTwo = Nothing
    Set rngTwo = Nothing

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With

    ended = timeGetTime
    Debug.Print ColumnCount * RowCount & " Cells Painted In " & (ended - started) / 1000 & " seconds"
End Sub

VBA快速绘制地址数组中成千上万个单元的方法

1 个答案: