总结报告：修改解决方案

Question

这是对问题的跟进。

Grade 'Eh' Bacon 提供的解决方案假设每个十进制代码对应一个特定的状态，但事实并非如此。十进制代码必须先转换为二进制，每一位对应一个特定的描述。因此，例如，0000000000000001 将仅对应于一种状态 "Idle Cutout Active"，而 0000000001000001 将对应于两种状态 "High Coolant Temperature" 和 "Idle Cutout Active".

我设计了一种方法将 16 位字符串拆分为每一位并填充一系列列，这样我的数据如下所示：

注意：数据继续远远超出上图中可以看到的行；一直到第 8651 行。

有没有一种方法可以修改此解决方案以计算 D 到 S 的 1s 列，而不是查看 B 列中的十进制代码？我想这会导致使用大量的列，所以也许有一种更优化的方法来完成我想要完成的事情。重申一下，我想做的是找到五个或更多连续 1 的开始和结束时间，每个 1 的时间戳都在 2 分钟以内，并让相应的描述符出现在该开始和结束时间戳上，这样我就可以实现上面显示的数据的可读性更高的格式。它看起来像：

那么，有没有办法修改当前的解决方案，或者我应该考虑一个全新的解决方案？如果是后者，你会推荐什么？

进行实验：

我已经将实施的 Bacon 解决方案等级 'Eh' 的示例工作簿和我正在使用的数据示例放在一起。该工作簿可以从 here 下载。

谢谢，

段

编辑 1：

我已经更改了 Tim Williams 发布的代码以满足我的需要，并且还添加了一些功能以使其更适合我正在做的事情。 Google Drive 上的文件有完整的更新代码，但总而言之，我对 Tim 的代码做了一些细微的改动，使其适合我的数据，然后又写了两个子程序。第一种是将代码为运行时出现的所有各种 "Flag#:XX" 值替换为引擎状态描述符，另一种是按它们的开始时间戳对值进行排序。这是他的代码经过我所做的更改后的样子：

Public Type flag
        tStart As Variant  'flag start time
        tLast As Variant   'last event time
        Count As Long      'number of 1's
End Type
Sub Report()
'Type to track data for each of the bit positions (event types)

    Dim flags() As flag
    Dim c As Range, nF As Long, i As Long, v, f, t
    Dim shtReport As Worksheet, bContinue As Boolean

    Set shtReport = ThisWorkbook.Sheets("Technician Report Summary")
    Set c = Sheets("RAW DATA").Range("C2")
    nF = Len(c.Value)
    ReDim flags(1 To nF)
    bContinue = True

    Do
        v = c.Value               'bitstring
        t = c.Offset(0, -2).Value 'timestamp

        If Len(v) = 0 Then
            'No more data, so insert a "dummy" value to trigger
            ' writing out any current "events"
            v = String(nF, "0")
            bContinue = False
        End If

        'loop over each "bit" in the string
        For i = 1 To nF
            f = Mid(v, i, 1)
            If f = "1" Then
                'first instance of this flag ?
                If flags(i).Count = 0 Then
                    flags(i).tStart = t 'event begins - set start time
                Else
                    flags(i).tLast = t 'event continues - set "last" time
                End If
                flags(i).Count = flags(i).Count + 1
            End If
            If f = "0" Then
                'end of a run of 5 or more 1's ?
                If flags(i).Count >= 5 Then
                    'write event to Report sheet
                    With shtReport.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                        .Value = "Flag#:" & i
                        .Offset(0, 1).Value = flags(i).tStart
                        .Offset(0, 2).Value = flags(i).tLast
                    End With
                End If
                flags(i).Count = 0
            End If
        Next i

        Set c = c.Offset(1, 0)

    Loop While bContinue
    Call Sort
    Call FindAndReplace

End Sub

我认为它现在可以满足我的需求。我会进一步验证，但就目前而言，我认为我已经找到了一个可行的解决方案。

Answer 1

您可以尝试这样的操作：

'Type to track data for each of the bit positions (event types)
Public Type flag
    tStart As Variant  'flag start time
    tLast As Variant   'last event time
    Count As Long      'number of 1's
End Type

Sub Report()

    Dim flags() As flag
    Dim c As Range, nF As Long, i As Long, v, f, t
    Dim shtReport As Worksheet, bContinue As Boolean

    Set shtReport = ThisWorkbook.Sheets("Report")
    Set c = Sheet1.Range("B2")
    nF = Len(c.Value)
    ReDim flags(1 To nF)
    bContinue = True

    Do
        v = c.Value               'bitstring
        t = c.Offset(0, -1).Value 'timestamp

        If Len(v) = 0 Then
            'No more data, so insert a "dummy" value to trigger
            ' writing out any current "events"
            v = String(nF, "0")
            bContinue = False
        End If

        'loop over each "bit" in the string
        For i = 1 To nF
            f = Mid(v, i, 1)
            If f = "1" Then
                'first instance of this flag ?
                If flags(i).Count = 0 Then
                    flags(i).tStart = t 'event begins - set start time
                Else
                    flags(i).tLast = t 'event continues - set "last" time
                End If
                flags(i).Count = flags(i).Count + 1
            End If
            If f = "0" Then
                'end of a run of 5 or more 1's ?
                If flags(i).Count >= 5 Then
                    'write event to Report sheet
                    With shtReport.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
                        .Value = "Flag#:" & i
                        .Offset(0, 1).Value = flags(i).tStart
                        .Offset(0, 2).Value = flags(i).tLast
                    End With
                End If
                flags(i).Count = 0
            End If
        Next i

        Set c = c.Offset(1, 0)

    Loop While bContinue

End Sub

编辑：修复了几个拼写错误并解释了如果有事件 "ongoing"

数据末尾发生的情况

总结报告：修改解决方案

Summary Report: Modifying Solution

excel

vba

excel-2013