Excel VBA - 自动趋势填充错误

时间:2015-09-17 12:08:21

标签: excel-vba trending vba excel

我有一堆这样的数据:

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列中的开始和结束字段是否填充。我错过了代码的全部功能,因此我不知道如何修改以解决问题 有没有人看到任何明显和明显的问题区域,并可以建议添加或减少代码来解决这个问题? 即使在步骤中解释代码的功能也会有所帮助 提前谢谢!

2 个答案:

答案 0 :(得分:0)

我以另一种方式重写了你的日常工作,似乎工作正常。肯定会添加一些错误处理......由你决定。

var regex = /^\w+@\w+\.\w{2,3}$/;

答案 1 :(得分:0)

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

这满足了问题的要求。