添加格式的更快方法

我有234,000行數據和一個應用格式的宏。宏需要大約一分鐘的時間運行。如果可能的話，我試圖縮短時間。添加格式的更快方法

每當列1發生更改時，都會添加一個邊框，並且第二列之後的所有數據都會在每一行之間添加一個邊框並進行着色。

這裏是數據的一個示例：

Example Data

這是宏：

Sub FormatData() 
    Dim PrevScrnUpdate As Boolean 
    Dim TotalRows As Long 
    Dim TotalCols As Integer 
    Dim PrevCell As Range 
    Dim NextCell As Range 
    Dim CurrCell As Range 
    Dim i As Long 
    Dim StartTime As Double 

    StartTime = Timer 

    PrevScrnUpdate = Application.ScreenUpdating 
    Application.ScreenUpdating = False 
    TotalRows = Rows(ActiveSheet.Rows.Count).End(xlUp).row 
    TotalCols = Columns(ActiveSheet.Columns.Count).End(xlToLeft).Column 

    Range(Cells(1, 1), Cells(1, TotalCols)).Font.Bold = True 

    For i = 2 To TotalRows 
     Set NextCell = Cells(i + 1, 1) 
     Set CurrCell = Cells(i, 1) 
     Set PrevCell = Cells(i - 1, 1) 

     If CurrCell.Value <> NextCell.Value Then 
      Range(CurrCell, Cells(i, 2)).Borders(xlEdgeBottom).LineStyle = xlSolid 
     End If 

     If CurrCell.Value <> PrevCell.Value Then 
      Range(CurrCell, Cells(i, 2)).Borders(xlEdgeTop).LineStyle = xlSolid 
     End If 

     Range(Cells(i, 3), Cells(i, TotalCols)).BorderAround xlSolid 
     Range(Cells(i, 3), Cells(i, TotalCols)).Interior.Color = RGB(200, 65, 65) 
    Next 

    Application.ScreenUpdating = PrevScrnUpdate 
    Debug.Print Timer - StartTime 
End Sub

編輯：下面是結果的一個例子：

Result

編輯2：我已經試過這個數組，它不提高速度。

來源

2013-07-22 Ripster

這是Excel 2007還是以上？爲什麼不使用條件格式？ – rene

Excel 2010中，我沒有想過條件格式可以每次在列中更改值時添加邊框。 – Ripster

@Ripster [它可以]（http://stackoverflow.com/q/5194286/11683）。 – GSerg

我可能會開始考慮將需要循環的列放在數組中並比較相鄰的字符串。然後進行更新。循環和比較應該比陣列更快，邊界格式的開銷可能相同。

Dim ii As Long, firstRow As Integer ' a counter variable and the first row offset 
Dim myColumn() As String ' create a string array 
ReDim myColumn(firstRow To firstRow + TotalRows) ' resize to hold the number of rows of data 
myColumn = Range(Cells(1,1),Cells(1,TotalRows)).Value ' write the range to the array 
For ii = (LBound(myColumn) + 1) To (UBound(myColumn) - 1) 
    If myColumn(ii) <> myColumn(ii+1) Then 
     Range(Cells(ii,1),Cells(ii,Ncol)).Borders(xlEdgeBottom).LineStyle = xlSolid 
    Else If myColumn(ii) <> myColumn(ii-1) 
     Range(Cells(ii,1),Cells(ii,Ncol)).Borders(xlEdgeTop).LineStyle = xlSolid 
    End If 
Next

我幾乎總是試圖讓大名單成一個類型數組，如果我知道我需要循環，除非它是數據的一個微不足道的金額。另一個選項可能是將整個範圍複製到Range類型的數組中，更新與該值匹配的行，然後再將其放回。

Dim myColumns() As Range 
ReDim myColumns(1 To TotalRows,1 To TotalCols) 
myColumns = Range(Cells(1,1),Cells(TotalRows,TotalCols) 
For ii = LBound(myColumns,1) + 1 To UBound(myColumns,1) - 1 
    If myColumns(ii,1) <> myColumns(ii+1,1) Then 
     ' ... update the bottom border 
    Else If myColumns(ii,1) <> myColumns(ii-1,1) Then 
     ' ... update the top border 
    End If 
Next 
' Once we've done the updates, put the array back in place 
Range(Cells(1,1),Cells(TotalRows,TotalCols)) = myColumns

來源

2013-07-22 19:55:22 Max

添加格式的更快方法

回答

相關問題