Question

如何处理以下任务？在单元格A2中，我有一个公式可以连续迭代并提供结果。每次迭代时，结果都列在B2，B3等中。

同时在C2，C3等中，我捕获了相应的时间戳。基本上，经过几次迭代，我在B列中有一个结果列表，在C列中有一个时间戳列表。我已经设法编写了这一部分。

由于我的问题：由于我有时间戳记，所以我会一时间知道例如第1分钟内产生6个结果。因此，我们正在查看的结果范围为B2：B7。

基于该扩展范围，随着范围随着每次迭代而变化，直到达到B7为止，我需要捕获E2中的最大结果。由于我不知道第一分钟会产生多少结果，因此我需要在每次迭代中更新E2。第2分钟开始后，我希望能够这样做并在E3中捕获最大结果。新范围显然将从B8开始，并根据A2中进行了多少次计算而扩大。

如果我可以做10分钟，那么我会在从E2到E11的范围内看到10个最大结果。

下面是我的代码。它只能部分执行我上面描述的操作。有什么想法使它起作用吗？非常感谢您的帮助！谢谢！

在以下链接下，我已经看到了问题所在：

Private Sub Worksheet_Calculate()
Dim lastrow As Long

lastrow = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row

With Worksheets(1).Cells(lastrow, 2)
    .Offset(1, 0) = Cells(2, 1).Value
    .Offset(1, 1) = FormatDateTime(Now, vbLongTime)
End With

Call Generator

End Sub

Sub Generator()
Dim icount As Long
Dim rcount As Long

icount = 2
rcount = 2
For tcount = 1 To 10
    Do While DateDiff("s", Cells(2, 3), Cells(icount, 3)) <= tcount * 60 
        Cells(tcount + 1, 5) = WorksheetFunction.Max(Range(Cells(rcount,   2), Cells(icount, 2))) 
        icount = icount + 1
    Loop
rcount = icount
Next tcount

End Sub

Answer 1

解决此问题的一种方法是检查每次迭代的时间以及分钟是否不同，以便随时随地填充列E。

类似这样的东西：

Private Sub Worksheet_Calculate()
Dim lastrow As Long

lastrow = Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row

With Worksheets(1).Cells(lastrow, 2)
    .Offset(1, 0) = Cells(2, 1).Value
    .Offset(1, 1) = FormatDateTime(Now, vbLongTime)
    If Minute(.Offset(1, 1).Value) <> Minute(.Offset(0, 1).Value) Then
        .Offset(1, 2) = "Change"
        .Offset(0, 3).End(xlUp).Offset(1, 0) = WorksheetFunction.Max(Range(.Offset(0, 0), .Offset(0, 2).End(xlUp).Offset(0, -2)))
    End If
End With

您可以取消使用Generator功能。这里将不需要它。额外的一行将最近添加的时间戳的分钟值与先前的值进行比较，如果其不同之处（即分钟）发生了变化，则会在E列中标记有助于计算最大值的行。

Answer 2

您可以跟踪分钟范围的起始单元格并计算时差。如果相差超过60秒，请调整结果单元格。代码中的注释说明了所有内容。在您的Worksheet_Calculate中调用它。请注意，您可以将Private变量与Static一样。

在标准模块中：

Private start_cell As Range
Private end_cell As Range
Private result_cell As Range

Sub UpdateResult()

    Dim r%, diff%
    Dim rng As Range

    With Sheets("Tabelle1")

        '// Calculate last added cell
        Set end_cell = .Cells(.Rows.Count, "C").End(xlUp)

        '// Check whether the last cell is first cell
        If (end_cell.Address(0, 0) = "C2") Then
            '// Experiment just began. Set initial data.
            Set result_cell = .Range("E2")
            Set start_cell = .Range("C2")
        Else
            '// Experiment is in progress.
            '// Calculate seconds diff.
            diff = DateDiff("s", start_cell, end_cell)
            If diff > 60 Then
                '// Shift result cell
                '// and update start_cell
                Set start_cell = end_cell
                Set result_cell = result_cell.Offset(1)
            End If
        End If

        '// After calculating all required cells,
        '// write down values.
        Set rng = Range(start_cell, end_cell)
        result_cell.Value = WorksheetFunction.Max(rng.Offset(, -1))

    End With

End Sub

扩大范围内的最大值

2 个答案: