简体   繁体   中英

Excel VBA - Automatic Trend-Fill error

I have a stack of data like this:

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

Then using this code I trend the values starting from the bottom:

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

This fills the table out like this:

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

So this generally only works partially and I'm not quite sure why.
As you can tell by the table it just decides to cause gaps and not trend for me at all. The code works if there is no value in column B at the top or bottom. But in some cases I need to automatically fill in the start and end values, and this is where the code breaks down.
And to be fair I have to run this code twice to properly fill in the entire table regardless of whether the start and end fields in column B are filled or not. I'm missing the entire function of the code and so therefore I have no idea how to edit to fix the problem.
Does anyone see any glaring and obvious problem areas and can suggest additions or subtractions to the code to fix this?
Even explaning the function of the code in steps would be helpful.
Thank you in advance!

I rewrote you routine another way, it seems to work ok. Some error handling could surely be added...up to you.

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

This fullfilled the requirements of the question.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM