簡單的循環過去很快，現在很慢

我有一段簡單的代碼，用來在瞬間焚燒45,000行數據，現在需要很長時間（〜15分鐘）。我已經閱讀了一些類似的問題，但因爲它非常基本，所以想發佈代碼。此代碼將訂單的每個項目（每行一個項目）的單個權重相加，然後爲總項目的每個項目填充一個單元格。它從上到下得到總數，然後從下到上填充空白。我錯過了什麼？簡單的循環過去很快，現在很慢

Sub FillInTotalWeight() 
' 
' sort whole file by process order 

' 
'this macro sums all the children weights in a process order 
'and then puts that total in column E for every child of the process order 
' 

Dim nLastRow As Long 
Dim nRow As Long 
Dim wtTot As Long 
Dim nStop As Long 

' 
'determine the last row 
' 
nLastRow = ActiveSheet.UsedRange.Rows.Count 

' 
'sort by process order 
' 
ActiveWorkbook.Worksheets("zpr2013b").Sort.SortFields.Clear 
ActiveWorkbook.Worksheets("zpr2013b").Sort.SortFields.Add _ 
    Key:=Range(Cells(1, "D"), Cells(nLastRow, "D")), _ 
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal 
With ActiveWorkbook.Worksheets("zpr2013b").Sort 
    .SetRange Range(Cells(1, "A"), Cells(nLastRow, "q")) 
    .Header = xlYes 
    .MatchCase = False 
    .Orientation = xlTopToBottom 
    .SortMethod = xlPinYin 
    .Apply 
End With 

wtTot = Cells(2, "B").Value 

' 
'go top to bottom and put the total weight of each process order 
'in the row of the last coil produced 
' 
For nRow = 2 To nLastRow 
    If Cells(nRow, "D").Value = Cells(nRow + 1, "D").Value Then 
     wtTot = wtTot + Cells(nRow + 1, "B").Value 
    Else 
     Cells(nRow, "E").Value = wtTot 
     wtTot = Cells(nRow + 1, "B").Value 
    End If 
Next nRow 

' 
'go bottom to top and fill in all the blanks of the other coils 
' 
For x = nLastRow To 2 Step -1 
    If Cells(x, "E").Value = "" Then 
     Cells(x, "E").Value = Cells(x + 1, "E").Value 
    End If 
Next x 

End Sub

來源

2014-11-04 erich

嘗試增加'Application.Screenupdating = FALSE'在你的代碼的頂部（'子FillInTotalWeight'後）和'Application.Screenupdating =真'在'End Sub'之前的底部。這可能會加快你的代碼的速度。 – Daniel 2014-11-04 23:29:47

我會推薦使用此代碼。它應該運行你更快，將完成同樣的事情：

Sub FillInTotalWeight() 

    Dim ws As Worksheet 

    Set ws = ActiveWorkbook.Sheets("zpr2013b") 

    ws.UsedRange.Sort Intersect(ws.UsedRange, ws.Columns("D")), xlAscending, Header:=xlYes 
    With Range("E2", ws.Cells(Rows.Count, "D").End(xlUp).Offset(, 1)) 
     .Formula = "=SUMIF(D:D,D" & .Row & ",B:B)" 
     .Value = .Value 
    End With 

End Sub

來源

2014-11-04 23:33:53 tigeravatar

簡單的循環過去很快，現在很慢

回答

相關問題