Excel VBA - Автоматическая ошибка Trend-Fill

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 

Это fullfilled требования вопроса.