用vba修复时间序列的date轴

我有一个代码，从Excel中获取数据，并生成一个graphics。 它需要一些input（因为完成多个图），创build一个新的图表工作表并插入数据。

问题1我的代码从指定表中获取UsedRange，并使用它填充graphics。 数据从A1开始，一直持续到结束。 然而，其中一个图表的第一行有数据，不应该进入图表。 敌人的例子：

这是一个正常的图表：

Item 1 Item 2 day 1 100 100 day 2 110 180 day 3 90 110 day 4 70 130 

等等。 这是例外：

  Item 1 Item 2 day 1 1 1 day 2 110 180 day 3 90 110 day 4 70 130 

问题1在这第二种情况下，我想从图中删除第一行数据（不是标识符行）。 既然我正在使用UsedRage，那怎么做呢？

问题2对于所有的图表，数据系列从过去的某个时刻开始，直到今天。 问题在于，当date序列被绘制时，它从第一天开始计数（逐步通过周期，例如6个月）直到它到达最近的date。

在这种情况下，它不包括今天的date，这是我想要实现的。

为了举例说明：

在这种情况下，我的数据一直持续到十二月七号，但最后一次出现的date是十月三十一日。

问题2这可以解决吗？

Obs：我已经尝试过使用logging器为此生成一个代码，但是即使在embedded式的excel选项中，我也找不到任何方法来做到这一点。

到目前为止的代码：

 Function Grapher(ChartSheetName As String, SourceWorksheet As String, ChartTitle As String, secAxisTitle As String) Dim lColumn As Long, lRow As Long Dim LastColumn As Long, LastRow As Long Dim RetChart As Chart Dim w As Workbook Dim RetRange As Range Dim chrt As Chart Dim p As Integer Dim x As Long, y As Long Dim numMonth As Long Dim d1 As Date, d2 As Date Set w = ThisWorkbook 'find limit LastColumn = w.Sheets(SourceWorksheet).Cells(1, w.Sheets(SourceWorksheet).Columns.Count).End(xlToLeft).column LastRow = w.Sheets(SourceWorksheet).Cells(w.Sheets(SourceWorksheet).Rows.Count, "A").End(xlUp).Row If SourceWorksheet <> "DD" Then 'this is the exception case Set RetRange = w.Sheets(SourceWorksheet).UsedRange 'HOW CAN i CHANGE THE RANGE TO ACCOUNT FOR THE PROBLEM 1? Else Set RetRange = w.Sheets(SourceWorksheet).UsedRange End If ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' For Each chrt In w.Charts If chrt.Name = ChartSheetName Then Set RetChart = chrt RetChart.Activate p = 1 End If Next chrt If p <> 1 Then Set RetChart = Charts.Add End If 'count the number of months in the time series, do the ratio d1 = w.Sheets(SourceWorksheet).Range("A2").Value d2 = w.Sheets(SourceWorksheet).Range("A" & LastRow).Value numMonth = TestDates(d1, d2) x = Round((numMonth / 15), 1) 'ratio to account for period size If x < 3 Then y = 1 ElseIf x >= 3 And x < 7 Then y = 4 ElseIf x > 7 Then y = 6 End If 'create chart With RetChart .Select .ChartType = xlLine .HasTitle = True .ChartTitle.Text = ChartTitle .SetSourceData Source:=RetRange .Axes(xlCategory, xlPrimary).HasTitle = True .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date" .Axes(xlValue, xlPrimary).HasTitle = True .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = secAxisTitle .Name = ChartSheetName .SetElement (msoElementLegendBottom) .Axes(xlCategory).TickLabelPosition = xlLow .Axes(xlCategory).MajorUnit = y .Axes(xlCategory).MajorUnitScale = xlMonths End With End Function ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Function TestDates(pDate1 As Date, pDate2 As Date) As Long TestDates = DateDiff("m", pDate1, pDate2) End Function 

任何帮助将深表感谢。

Answer 1

问题1：

如果开始单元格应该是A2你可以试试这个：

Set RetRange = w.Sheets(SourceWorksheet).Range("A2:C" & LastRow)

问题2：

我在你的图表上看到X轴上显示的数据间隔是4个月。 据我所知，没有办法迫使excel做出不规则的间隔，并强制显示最后一个值的附加标签。

你可以尝试添加一个标签到最后一个数据点： label-last-point

编辑：添加屏幕到我的评论

Answer 2

大量修改代码和其他post和人的帮助后，我终于可以解决问题1。

问题1可以通过将范围设置为全部并且在创buildgraphics时重置数据来解决。 它的代码是（将添加在“与”）：

 If SourceWorksheet = "DD" Then For lColumn = 2 To LastColumn .FullSeriesCollection(lColumn - 1).Name = "=DD!$" & Col_Letter(lColumn) & "$1" .FullSeriesCollection(lColumn - 1).Values = "=DD!$" & Col_Letter(lColumn) & "$3:$" & Col_Letter(lColumn) & "$" & LastRow Next lColumn End If End With 

问题2我一直在清理networking，但显然没有办法倒退，然后镜像图，所以仍然没有解决。