[英]Excel VBA - Automatic Trend-Fill error
我有一堆这样的数据:
Tidal Time Tidal Height
00:00:00 4.40
01:00:00
02:00:00
03:00:00
04:00:00
05:00:00
06:00:00 2.00
07:00:00
08:00:00
09:00:00
10:00:00
11:00:00 4.50
12:00:00
13:00:00
14:00:00
15:00:00
16:00:00
17:00:00
18:00:00 2.10
19:00:00
20:00:00
21:00:00
22:00:00
23:00:00 4.40
然后,使用此代码,我将从底部开始对值进行趋势处理:
Sub TrendValues()
Set LastCell = Sheets("Vessels").Cells(ActiveSheet.Rows.Count, 2).End(xlUp)
Do While LastCell.Row > 2
If LastCell.Offset(-1, 0) = "" Then
Set NonEmptyCellAboveLastCell = LastCell.End(xlUp)
Else
Set NonEmptyCellAboveLastCell = LastCell.Offset(-1, 0)
End If
If NonEmptyCellAboveLastCell.Row > 1 Then
Set RangeToFill = Sheets("Vessels").Range(NonEmptyCellAboveLastCell, LastCell)
RangeToFill.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Trend:=True
If NonEmptyCellAboveLastCell.Offset(-1, 0) = "" Then
Set LastCell = NonEmptyCellAboveLastCell.End(xlUp)
Else
Set LastCell = NonEmptyCellAboveLastCell.Offset(-1, 0)
End If
Else
Set LastCell = Sheets("Vessels").Range("B1")
End If
Loop
End Sub
像这样填写表格:
Tidal Time Tidal Height
00:00:00 4.40
01:00:00
02:00:00
03:00:00
04:00:00
05:00:00
06:00:00 2.00
07:00:00 2.50
08:00:00 3.00
09:00:00 3.50
10:00:00 4.00
11:00:00 4.50
12:00:00
13:00:00
14:00:00
15:00:00
16:00:00
17:00:00
18:00:00 2.10
19:00:00 2.56
20:00:00 3.02
21:00:00 3.48
22:00:00 3.94
23:00:00 4.40
因此,这通常仅部分起作用,我不确定为什么。
正如您在表格中可以看出的那样,它只是决定造成差距,而不是对我而言完全没有趋势。 如果顶部或底部的B列中没有值,则该代码有效。 但是在某些情况下,我需要自动填写起始值和结束值,这是代码崩溃的地方。
公平地说,无论是否填充了B列的开始和结束字段,我都必须运行两次此代码以正确地填充整个表。 我缺少代码的整个功能,因此我不知道如何进行编辑以解决问题。
是否有人看到任何明显的明显问题区域,并且可以建议对代码进行增减来解决此问题?
即使逐步介绍代码的功能也将有所帮助。
先感谢您!
我用另一种方式改写了您的例行程序,看来工作正常。 肯定可以添加一些错误处理...由您决定。
Sub TrendValues()
Dim rng As Range, ar As Range, toFill As Range
Set rng = Intersect(Range("a1").CurrentRegion, Range("B:B")).SpecialCells(xlCellTypeBlanks)
For Each ar In rng.Areas
'add 1 cell above and one below
Set toFill = ar.Offset(-1, 0).Resize(ar.Rows.Count + 2, 1)
toFill.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Trend:=True
Next ar
End Sub
Sub ErrorFix()
Dim Bounds As Range
Set Bounds = Range("A1").CurrentRegion
Dim c As Range
Set c = Range("B2")
Do While c.Row < Bounds.Rows(Bounds.Rows.Count).Row
If IsEmpty(c.Offset(1, 0).Value) Then
Dim RangeToFill As Range
Set RangeToFill = Application.Intersect(Range(c, c.End(xlDown)), Bounds)
RangeToFill.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Trend:=True
Set c = RangeToFill.Cells(RangeToFill.Cells.Count)
Else
Set c = c.End(xlDown)
End If
Loop
End Sub
这满足了问题的要求。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.