2016-06-10 37 views
0

到目前爲止我有這個,它對於大數據集非常慢。任何幫助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 
+1

爲什麼不使用條件格式與如下因素公式:'= MOD(ROW(),2)= 1' ? –

+0

我正在使用VB6應用程序來處理Excel應用程序對象。由於我自動執行excel,因此無法輸入任何公式。我將大數組轉儲到工作表中,並且無法自動化所有這些單元。 –

+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

替代和非常快速(50,000列在任何時間)方法,無需條件格式:

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 
相關問題