Question

我有一段简单的代码，用于在眨眼间刻录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

Answer 1

我建议使用此代码。它应该为你运行得更快，并将完成同样的事情：

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

简单的循环过去很快，现在很慢

1 个答案: