vba寻找一种快速突出显示每一行的方法

时间:2016-06-10 23:06:38

标签: excel vba performance

到目前为止,我有这个,而且大数据集的速度非常慢。任何帮助

'For every row in the current selection...
For Counter = 1 To RNG.Rows.Count 'reccnt
    'If the row is an odd number (within the selection)...
    If Counter Mod 2 = 1 Then
        With RNG.Rows(Counter).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.799981688894314
                .PatternTintAndShade = 0
        End With
    End If
Next

3 个答案:

答案 0 :(得分:2)

试一试。我想它会加快速度。它几乎立即为我奔跑。

Sub ColorEven()
    Set rng = Rows("1:40000")
    rng.FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(ROW(),2)=0"
    rng.FormatConditions(1).Interior.Pattern = xlSolid
    rng.FormatConditions(1).Interior.PatternColorIndex = xlAutomatic
    rng.FormatConditions(1).Interior.ThemeColor = xlThemeColorAccent6
    rng.FormatConditions(1).Interior.TintAndShade = 0.799981688894314
    rng.FormatConditions(1).Interior.PatternTintAndShade = 0
End Sub

答案 1 :(得分:1)

没有条件格式的替代且非常快(50k行,没有时间)方法:

Option Explicit

Sub main()

    Dim i As Long, nRows As Long
    Dim hlpCol As Range
    Dim indexArray1() As Long, indexArray2() As Long

    With Range("A1:A50000")
        nRows = .Rows.Count '<~~ retrieve n° of rows to be processed
        ReDim indexArray1(1 To nRows) '<~~ redim indexArray1 accordingly
        ReDim indexArray2(1 To nRows) '<~~ redim indexArray2 accordingly

        ' fill indexArrays
        For i = 1 To nRows
            indexArray1(i) = i 'indexArray1, which stores the initial range order
            indexArray2(i) = IIf(.Cells(i, 1).Row Mod 2 = 1, i, nRows + i) 'indexArray2, "marks" range "even" rows to be "after" "uneven" ones
        Next i

        Set hlpCol = .Offset(, .Parent.UsedRange.Columns.Count) '<~~ set a "helper" column ...
        hlpCol.Value = Application.Transpose(indexArray1) '<~~ ... fill it with indexArray1...
        hlpCol.Offset(, 1).Value = Application.Transpose(indexArray2) '<~~ ... and the adjacent one with indexArray2

        .Resize(, hlpCol.Column + 1).Sort key1:=hlpCol.Offset(, 1) '<~~ sort range to group range "uneven" rows before "even" ones

        ' format only half of the range as wanted
        With .Resize(.Rows.Count / 2).Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent6
            .TintAndShade = 0.799981688894314
            .PatternTintAndShade = 0
        End With

        .Resize(, hlpCol.Column + 1).Sort key1:=hlpCol '<~~ sort back the range to its initial order

    End With
    hlpCol.Resize(, 2).Clear '<~~ clear helper columns

End Sub

答案 2 :(得分:0)

使用桌子!!它会自动着色。