Excel通過使用Variant而不是範圍的宏來提高性能

Question

我有這個宏來檢查在列A中是否包含「F」的單元格，然後從列CC檢查最後一次使用的行（我希望我知道這是正確的，因爲只是CC列是最長的） 如果發現「F」，則右側的每個單元向下移動兩個位置。工作表具有從列的數據，直到IW

Dim rng As Range 
Dim LastRow As Long 

Application.ScreenUpdating = False 
With ActiveSheet 
    LastRow = .Cells(.Rows.Count, "CC").End(xlUp).Row 
End With 

For Each rng In Range(Sheets(1).Range("A1"), Sheets(1).Range("A" & LastRow).End(xlUp)) 

If rng.Text = "F" Then 
    rng.Offset(-1, 0).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    rng.Offset(-1, 0).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    rng.Offset(-1, 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    rng.Offset(-1, 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    rng.Offset(-1, 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    rng.Offset(-1, 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    ... 
    rng.Offset(-1, 256).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    rng.Offset(-1, 256).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    End If 
Next rng 
Range("A1").Select 
Application.ScreenUpdating = TRUE 

不幸的是，大數據時，我得到了750+行這個宏是極其緩慢，處理時間，即使在一個雙Xeon處理器會長達90分鐘（雙核各的處理器）與16GB RAM機器。 我試圖做關閉屏幕更新的性能優化，所有的Excel工作表都沒有相對公式，只是應該向下移動兩行數據...

經過大量的谷歌搜索，我發現這個頁面從Office博客，我注意到，而不是抵消變體應該是多了很多在我的情況好轉：

http://blogs.office.com/2008/10/03/what-is-the-fastest-way-to-scan-a-large-range-in-excel/

我嘗試了一些變化通過聲明rng爲Variant代替範圍，但還是一樣慢結果。

你能否告訴我應該如何更改我的代碼以使用可能的變體並實現最佳性能？

Answer 1

對於只有750行，使用數組循環會產生微不足道的差異。你正在做的是在256列中分別插入2個單元。嘗試一次插入整行。我也會在相反的範圍內循環。此外，您的.Insert不會向下移動當前單元格，它會將單元格移到當前單元格的上方一個。請如下調整。

Dim rng As Range 
Dim LastRow, i As Long 

Application.ScreenUpdating = False 
With ActiveSheet 
    LastRow = .Cells(.Rows.Count, "CC").End(xlUp).Row 
End With 

For i = LastRow to 1 Step -1 
set rng = Cells(i,1) 
If rng.Text = "F" Then 
    Range("A" & i & ":" & "BZ" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftorAbove 
    Range("A" & i & ":" & "BZ" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftorAbove 
    Range("CA" & i & ":" & "CI" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftorAbove 
    'rng.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    'rng.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    End If 
Next i 
Range("A1").Select 
Application.ScreenUpdating = TRUE