ExcelVBA测定卡车运输的质量-ExcelVBADeterminingMassofTruckShipments

I have a system where I have a list of data from a truck scale reading the weight of a truck on a scale. This data ranges from -30,000lbs or so due to the scale being tared but truckless, to 40,000lbs with a full and tared truck on it. My task is to determine the total weight that has left our facility via truck. The problem is some days only a few trucks leave our facility and others a dozen leave, all with slightly different weights.

我有一个系统，我有一个从卡车秤上读取卡车重量的数据列表。这个数据的范围从-3万磅左右，这是由于没有卡车的车身，到4万磅，上面有一辆满载的卡车。我的任务是通过卡车确定离开我们工厂的总重量。问题是，有些日子，只有几辆卡车离开我们的工厂，有些则是十几辆，重量略有不同。

The graph of these weights looks like a saw tooth pattern. It is a largely negative value (due to tare), quickly reaches approximately zero as a truck pulls onto the scale, and slowly builds to a final weight. After the final weight is reached the weight quickly goes back to the largely negative value as the truck pulls away.

这些重量的图形看起来像锯齿图形。这是一个很大的负值(由于皮重)，当一辆卡车拉上磅秤时，速度很快接近于零，并且慢慢地增加到最后的重量。当最后的重量达到后，重量迅速回到了很大程度上的负值随着卡车的驶离。

My idea on how to approach this is look for where the data is less than zero and return the max weight of the sensor between zeros. If the max weight is above some noise filter value (say, 5000lbs) then add the max weight to some counter. In theory, not bad, in practice, a bit out of my league.

我的想法是寻找数据小于零的地方，并在0之间返回传感器的最大重量。如果最大权重大于某个噪声过滤值(比如，5000lbs)，则将最大权重添加到某个计数器。从理论上讲，还不错，但实际上，我有点力不从心。

Here's my code so far, as I know I need to show my effort so far. I recommend ignoring it as it's mostly just a failed start after a few days of restarting work.

这是我目前的代码，我知道我需要展示我的努力。我建议忽略它，因为在重新开始工作几天后，它只是一个失败的开始。

Public Function TruckLoad(rngData As Range)
Dim intCount As Integer
intCount = 0
For Each cell In rngData
    intCount = intCount + 1
Next cell
Dim n As Integer
n = 1
Dim x As Integer
x = 1
Dim arr() As Double
For i = 1 To intCount
    If rngData(i, 1) <0 Then
        arr(n) = x
        n = n + 1
        x = x + 1
    Else
        x = x + 1
    End If
Next
TruckLoad = arr(1)

End Function

If anyone could give me advice on how to proceed it would be extremely valuable. I'm not a computer programmer outside of the very basics.

如果有人能给我关于如何进行的建议，那将是非常有价值的。除了最基本的东西，我不是电脑程序员。

Edit: Sorry, I should have said this initially. I can't post the entirety of the raw sample data but I can post a photo of a graph. There is a degree to which I can't post publicly (not that you can do anything particularly nefarious with the data, it's a corporate rule).

编辑:对不起，我应该一开始就说的。我不能发布全部的原始样本数据，但我可以发布一张图的照片。在某种程度上，我不能公开发布(不是说你可以用这些数据做任何特别邪恶的事情，这是公司的规则)。

www.imgur.com/a/LGQY9

www.imgur.com/a/LGQY9

1 个解决方案

Option Explicit

Private Const NOISE_FILTER As Double = 5000

Public Function TruckLoad(rngData As Range) As Double

    Dim r As Integer
    Dim runningTruckLoad As Double
    Dim maxLoadReading As Double
    Dim nextZeroRow As Integer

    For r = 1 To rngData.Rows.Count

        nextZeroRow = FindNextZeroRow(r, rngData)

        maxLoadReading = Application.WorksheetFunction.Max(Range(rngData.Cells(r, 1), rngData.Cells(nextZeroRow, 1)))

        If maxLoadReading > NOISE_FILTER Then
            runningTruckLoad = runningTruckLoad + maxLoadReading
        End If

        r = nextZeroRow 'skip the loop counter ahead to our new 0 row

    Next r

    TruckLoad = runningTruckLoad

End Function

Private Function FindNextZeroRow(startRow As Integer, searchRange As Range) As Integer

    Dim nextZeroRow As Range

    Set nextZeroRow = searchRange.Find(0, searchRange.Rows(startRow))

    If nextZeroRow.Row  0 Then  'we've found a data point with a zero in it, not interested in this row
        FindNextZeroRow = FindNextZeroRow(nextZeroRow.Row, searchRange)
    Else
        FindNextZeroRow = nextZeroRow.Row 'we've found our next zero data point
    End If

End Function