VBA - 根据 (n+1)-(n) 值添加空白行,如果小于某个值,则删除中间的任何内容

VBA - Add blank rows depending on (n+1)-(n) value then delete anything inbetween if less than a value

所以我正在写一个 VBA 来尝试自动执行一些数据分析,这将循环遍历数据并且任何时候行中的时间差超过一秒延迟(数据分辨率更高)它将添加一个空行,表示新的 'test run' 数据。然后,如果 RangeA 为 2 秒(即无意义的简短测试 运行),我想删除空白行之间的任何行(调用 RangeA)。

我已经设法创建了一些添加空白行的喜怒无常的代码,但它在我的 if 语句中返回 'type mismatch'。

之后我确实需要根据这些数据创建图表,所以我不确定添加空白行是否是最好的方式,否则以后会出现问题。

编辑 - 由于我之前搞砸了一些宏,发现一些单元格中有字符串。所以它现在确实用空白行分隔数据,现在是尝试消除每个块中小于 2 秒的任何内容的情况。

Sub dataSeperator()

    Dim rowStart As Long
    Dim rowEnd As Long
    Dim rowLoop As Long
    Dim FindColumn As Range

    rowStart = 3
    rowEnd = Sheets("Data").UsedRange.Rows(Sheets("Data").UsedRange.Rows.Count).row

    With Sheets("Data")
        Set FindColumn = Cells.Find(What:="Time", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= _
        xlWhole, MatchCase:=False)
    End With

      For rowLoop = rowEnd To rowStart Step -1

       With Sheets("Data").Cells(rowLoop, FindColumn.Column)

        If Cells(rowLoop - 1, FindColumn.Column) - Cells(rowLoop, FindColumn.Column) < -1 Then

            .EntireRow.Insert

        End If

    End With

Next rowLoop

End Sub

希望对您有所帮助。

Seperator()

    Dim rowStart As Long
    Dim rowEnd As Long
    Dim rowLoop As Long
    Dim FindColumn As Range

    rowStart = 3

    With Sheets("Data")

        rowEnd = .UsedRange.Rows(.UsedRange.Rows.Count).row

        ' replaced "Cells" with ".cells"
        Set FindColumn = .Cells.Find(What:="Time", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:= xlWhole, MatchCase:=False)

    End With

      For rowLoop = rowEnd To rowStart Step -1

       With Sheets("Data").Cells(rowLoop, FindColumn.Column)

        ' Used .Value instead
        ' "Cells" refers to the active sheet!
        ' use  Sheets("Data").Cells instead
        If Sheets("Data").Cells(rowLoop - 1, FindColumn.Column) - .value  < -1 Then
        ' If Cells(rowLoop - 1, FindColumn.Column) - Cells(rowLoop, FindColumn.Column) < -1 Then


            .EntireRow.Insert

        End If

    End With

Next rowLoop

End Sub

我的第一个答案仍然有效,但在我看来,如果您按以下方式工作,您可以提高代码的可读性和简单性。你怎么看?:

Sub Seperator2()

    Const TableHeaderRowNumber As Long = 1

    Dim cellTableHeaderWithTime As Range
    Dim rngMyTable As Range
    Dim rngMyColumnOfTimes As Range

    Dim rowStart As Long
    Dim rowEnd As Long
    Dim lngCounter As Long


    With Sheets("Data")

        Set cellTableHeaderWithTime = .Cells.Find(What:="Time", After:=.Cells(TableHeaderRowNumber, 1) _
                                                              , LookIn:=xlValues _
                                                              , LookAt:=xlWhole _
                                                              , MatchCase:=False)
        rowStart = TableHeaderRowNumber + 2
        rowEnd = .UsedRange.Rows(.UsedRange.Rows.Count).Row

        Set rngMyTable = .Range(.Cells(rowStart, cellTableHeaderWithTime.Column), .Cells(rowEnd, cellTableHeaderWithTime.Column))

        ' Just get the column of cells you need to compare
        Set rngMyColumnOfTimes = Intersect(rngMyTable, cellTableHeaderWithTime.EntireColumn)


        For lngCounter = rngMyColumnOfTimes.Cells.Count To rowStart Step -1

            'rngMyTable(lngCounter) is shorthand for rngMyTable.item(lngCounter)
            With rngMyTable(lngCounter)

                Debug.Print .Address

                If .Offset(-1, 0) - .Value < -1 Then

                    .EntireRow.Insert

                End If

            End With


        Next lngCounter


    End With

End Sub