循环计数器不会为大量循环递增

时间:2017-04-19 00:53:49

标签: excel vba

我有一个数据集,其中A列中有时间戳,B列中有数据。数据样本之间有4秒到30分钟。我创建了一个运行1小时的平均VBA代码来计算每行的1小时平均值。

数据文件长度可达800,000行。一切顺利,直到大约50,000行。在那之后,平均值开始超调或在几分钟内拍摄。有时它平均提供45分钟,其他提供1小时20分钟。

我在VBA有点新鲜,所以任何帮助都会受到赞赏。

    Sub One_hr_Avg()
'
' One_hr_Avg Macro
' Determines the cel range of an hour from the starting cell and computes the average of the power across that range.
'

'
Application.Calculation = xlCalculationManual
    'Set wks = ActiveWorkbook.Sheets("M_FPEB_Pwr_CV3_Plateau")

    'cell_rng: the user defined range of cells that the macro will search throughout for blanks.
    'cell: the current working cell.
    'cell_time: temp cell used to find the row of the cell ~1hr from the current cell.
    Dim cell_rng As Range
    Dim cell As Range
    Dim cell_time As Range

    'cell_start: the the starting time for the 1 hr avg.
    'cell_end: the end time for the 1 hr avg.
    Dim cell_start As Date
    Dim cell_end As Date
    Dim cell_start_temp As Date


    Dim hr_counter As Double
    Dim hr_counter_row As Double

    Dim StartTime As Double
    Dim MinutesElapsed As String

    'Remember time when macro starts
    StartTime = Timer


    'Ask the user for the cell range.
    Set cell_rng = Application.InputBox("Provide a range ($letter$number : $letter$number)", "Cell Range to Fill in Blanks", Type:=8)
    MsgBox "The cells selected were " & cell_rng.Address



    'Go through the cells and set equal to the value in the cell above if the current cell is blank.
    For Each cell In cell_rng

        'Get the time stamp of current cell and calculate the time 1hr ahead.
        cell_start = CDate(Cells(cell.Row, "B").Value)


        cell_start_temp = CDate(Cells(cell.Row, "B").Value)
        cell_end = DateAdd("h", 1, cell_start)
        hr_counter = 1

        Do While CDate(cell_start_temp) < CDate(cell_end)

            cell_start_temp = CDate(Cells(cell.Offset(hr_counter, 0).Row, "B").Value)
            hr_counter = hr_counter + 1

            If (hr_counter + cell.Row) > Cells(Rows.Count, "H").End(xlUp).Row Then
            Exit Do
            End If

        Loop

        hr_counter_row = cell.Row + hr_counter

        cell.Value = "=Average(" & "H" & cell.Row & ":" & "H" & hr_counter_row & ")"
        cell.Offset(0, 1).Value = CDate(cell_start_temp)

    Next cell

    'Determine how many seconds code took to run
    MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")

    'Notify user in seconds
    MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation

    Application.Calculation = xlCalculationAutomatic

End Sub

0 个答案:

没有答案