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
所以我正在写一个 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