Question

我需要一些帮助。好的，例如我在excel中有数据，这只是其中的一部分：

温度：（21,22,23,24,25,26,29,30,26 25,24,23,22），（24,25,26,30,27,28,29,25,21），19），（20,22,23,36,30,34,35,30,25,23），（24,26,30,34,28,25,20）

这些是液体的温度。温度一直升高到峰值，然后下降到一定温度（一个循环）。然后它会增加并再次下降（下一个周期）。在这些例子中有4个周期。它会重复，直到我有几个周期。对于每个每个温度，我可以计算其体积。我尝试编写代码来检测这些循环，因为我想计算每个循环的的平均值。但我不知道如何开始，因为我是VBA的新手。

谢谢

Answer 1

Before iamge of data

上面的屏幕截图显示我已将您的数据放在工作表Sheet1的第1列中。我有彩色单元格来帮助我检查我的宏，正确识别周期;宏既不设置也不使用这些颜色。

从单元格A2开始，宏搜索峰值，然后搜索标识循环的波谷值。然后循环以识别下一个循环。这一直持续到列表用完为止。

您没有说明您希望如何标记每个周期，因此我选择了一种可接受的方法。您可以从下面的屏幕截图中看到，我已将每个周期复制到从“G”列开始的行。我不知道你的音量计算，所以我把字符串Vol(n)作为占位符。您需要使用适当的公式替换它。平均值是平均温度;评论告诉您如何将其更改为平均音量。

After image of data

我希望这能让你开始。

Option Explicit
Sub SplitByCycle()

  Dim ColDestAverage As Long
  Dim ColDestCrnt As Long
  Dim ColDestTempFirst As Long
  Dim ColDestTitle As Long
  Dim ColSrc As Long
  Dim RowSrcCrnt As Long
  Dim RowSrcStartCycle As Long
  Dim RowDestCrnt As Long
  Dim VolumeCrnt As Double
  Dim VolumeTotal As Double

  ' Assume data starts in A2
  RowSrcCrnt = 2
  ColSrc = 1

  ' Output cycles starting from Row 2
  RowDestCrnt = 2
  ColDestTitle = 5
  ColDestAverage = 6
  ColDestTempFirst = 7

  With Worksheets("Sheet1")

    .Cells(RowDestCrnt - 1, ColDestAverage).Value = "Average"

    Do While True

      ' Record start of current cycle
      RowSrcStartCycle = RowSrcCrnt

      ' Search for cycle peak
      Do While True
        RowSrcCrnt = RowSrcCrnt + 1
        If .Cells(RowSrcCrnt - 1, ColSrc).Value > _
           .Cells(RowSrcCrnt, ColSrc).Value Then
          ' The last cell is greater than current cell so last cell was peak
          Exit Do
        End If
        ' Temperatures are still rising.  Continue search for peak
      Loop

      ' Search for cycle end
      Do While True
        RowSrcCrnt = RowSrcCrnt + 1
        If .Cells(RowSrcCrnt, ColSrc).Value = "" Or _
           .Cells(RowSrcCrnt - 1, ColSrc).Value < _
           .Cells(RowSrcCrnt, ColSrc).Value Then
          ' Either the end of the list of temperature has been reached or
          ' the last cell is less than the current cell.  Either way, the
          ' last cell is the end of the cycle
          Exit Do
        End If
        ' Temperatures are still falling.  Continue search for minimum
      Loop

      ' RowSrcStartCycle is the start of the current cycle
      ' RowSrcCrnt - 1   is the end of the current cycle

      ' Move current cycle to next destination row
      .Cells(RowDestCrnt, ColDestTitle).Value = "Temperatures"
      .Range(.Cells(RowSrcStartCycle, ColSrc), _
             .Cells(RowSrcCrnt - 1, ColSrc)).Copy
       .Cells(RowDestCrnt, ColDestTempFirst).PasteSpecial Paste:=xlPasteAll, _
                                Operation:=xlNone, SkipBlanks:=False, Transpose:=True
      RowDestCrnt = RowDestCrnt + 1

      ' Calculate volumes
      VolumeTotal = 0#
      .Cells(RowDestCrnt, ColDestTitle).Value = "Volumes"
      For ColDestCrnt = ColDestTempFirst To _
                        ColDestTempFirst + RowSrcCrnt - RowSrcStartCycle - 1
        VolumeCrnt = .Cells(RowDestCrnt - 1, ColDestCrnt).Value   ' Replace with calculation.  ######
        ' Replace "Vol(" & .Cells(RowDestCrnt - 1, ColDestCrnt).Value & ")"
        ' with VolumnCrnt.  ######
        .Cells(RowDestCrnt, ColDestCrnt).Value = _
                   "Vol(" & .Cells(RowDestCrnt - 1, ColDestCrnt).Value & ")"
        VolumeTotal = VolumeTotal + VolumeCrnt
      Next

      ' Calculate average
      .Cells(RowDestCrnt, ColDestAverage).Value = _
                          VolumeTotal / (RowSrcCrnt - RowSrcStartCycle)

      RowDestCrnt = RowDestCrnt + 2

      If .Cells(RowSrcCrnt, ColSrc).Value = "" Then
        ' Have reach end of list of temperatures
        Exit Do
      End If

      ' RowSrcCrnt is the first temperature of the next cycle

    Loop

  End With

End Sub

VBA编程识别模式

1 个答案: