Поиск и выделение последней точки данных в серии / столбце VBA

Question

У меня есть макрос для создания графика, и часть его идентифицирует и выделяет конечную точку данных, как показано ниже:

Это работает хорошо и хорошо, когда есть данные в последней строке столбца, но в некоторых случаях последняя строка пуста, поэтому ни одна точка не подсвечивается следующим образом:

Мне было интересно, есть ли способ сделать так, чтобы он выделил последнюю точку, которая содержит фактические данные, поэтому, хотя последняя строка может быть пустой, она выделяет последнюю строку с данными.

Может ли следующее быть включено в мой код? он находит последнюю точку данных в столбце B:

Dim lRow As Long

lRow = Cells(Rows.Count, 2).End(xlUp).Row

Вот мой код:

    With co.Chart
        .FullSeriesCollection(1).ChartType = xlXYScatter
        .FullSeriesCollection(1).AxisGroup = 1
        .FullSeriesCollection(2).ChartType = xlLine
        .FullSeriesCollection(2).AxisGroup = 1
        .SetSourceData Source:=my_range
        .Axes(xlCategory).TickLabels.NumberFormat = "m/yy"
        'highlight final dot of data
        .FullSeriesCollection(1).Points(.FullSeriesCollection(1).Points.Count).ApplyDataLabels Type:=xlShowValue
        .FullSeriesCollection(1).Points(.FullSeriesCollection(1).Points.Count).MarkerSize = 7
        .FullSeriesCollection(1).Points(.FullSeriesCollection(1).Points.Count).MarkerStyle = xlCircle
        .FullSeriesCollection(1).Points(.FullSeriesCollection(1).Points.Count).MarkerBackgroundColorIndex = 6
        .FullSeriesCollection(1).Points(.FullSeriesCollection(1).Points.Count).MarkerForegroundColorIndex = 1
        .HasTitle = True
        .ChartTitle.Text = t
        ResolveSeriesnames co.Chart
        .Location Where:=xlLocationAsObject, Name:="Graphs"

Answer 1

Я нашел этот код на https://peltiertech.com/label-last-point-for-excel-2007/ и внес пару изменений, которые работают

Sub LastPointLabel2()
  Dim srs As Series
  Dim iPts As Long
  Dim cht As ChartObject
  Dim vYVals As Variant
  Dim vXVals As Variant
  Set ws = ActiveSheet

  If ActiveChart Is Nothing Then
    MsgBox "Select a chart and try again.", vbExclamation
  Else
    Application.ScreenUpdating = False
  For Each cht In ws.ChartObjects
      Set srs = cht.Chart.SeriesCollection(1)
      With srs
        vYVals = .Values
        'vXVals = .XValues
        ' clear existing labels
        .HasDataLabels = False
        For iPts = .Points.Count To 1 Step -1
          If Not IsEmpty(vYVals(iPts)) Then
            ' add label
            srs.Points(iPts).ApplyDataLabels _
                ShowSeriesName:=False, _
                ShowCategoryName:=False, ShowValue:=True, _
                AutoText:=True, LegendKey:=False
            Exit For
          End If
        Next
      End With
    Next
    ' legend is now unnecessary
    Application.ScreenUpdating = True
  End If
End Sub