vba寻找一个快速的方式来突出每隔一行

到目前为止，我有这个，对于大数据集非常慢。 任何帮助

'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 

Answer 1

试试这个。 我想这会加快一点。 它几乎立即为我运行。

 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 

Answer 2

一个替代和非常快（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 

Answer 3

使用一张桌子！ 它会自动颜色绑定。