Excel VBA-自動趨勢填充錯誤

Question

我有一堆這樣的數據：

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列的開始和結束字段，我都必須運行兩次此代碼以正確地填充整個表。 我缺少代碼的整個功能，因此我不知道如何進行編輯以解決問題。
是否有人看到任何明顯的明顯問題區域，並且可以建議對代碼進行增減來解決此問題？
即使逐步介紹代碼的功能也將有所幫助。
先感謝您！

Answer 1

我用另一種方式改寫了您的例行程序，看來工作正常。 肯定可以添加一些錯誤處理...由您決定。

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

Answer 2

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

這滿足了問題的要求。