Question

我有一个从excel获取数据并生成图表的代码。它需要一些输入（因为完成了多个图表），创建一个新的图表工作表并插入数据。

问题1 我的代码从指定的工作表中获取UsedRange并使用它来填充图表。数据从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 对于所有图表，数据系列从过去的某个点开始，一直持续到今天。问题是，当绘制日期系列时，它会从第一天开始计算（逐步执行期间，例如6个月），直到达到最近的日期。

在这种情况下，它不包括今天的日期，这正是我想要实现的目标。

举例说明：

在这种情况下，我的数据将持续到12月7日，但最后一个日期是10月31日。

问题2 可以修复吗？

Obs：我已经尝试使用刻录机为此生成代码，但即使在嵌入式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

经过大量修改代码和其他帖子和人员的帮助后，我终于可以解决问题1.

问题1 可以通过将范围设置为total来解决，而不是在创建图形时重置数据。它的代码是（在“with”中添加）：

span{    
  position: absolute;
  top: 30%;
  left: 25%;
   }

a {
 position: absolute;
 height: 100px;
 width: 50px;
 background-color:#f2f2f2;
 border:solid 1px #333;
}

.b {
  position: absolute;
  left: 50px;
  height: 50px;
  width: 100px;
  background-color:#d9d9d9;
  border:solid 1px #333;
}

.c {
  position: absolute;
  left: 50px;
  top: 50px;
  width: 50px;
  height: 50px;
  background-color:#bfbfbf;
  border:solid 1px #333;
 }

.d {
  position: absolute;
  left: 100px;
  top: 50px;
  height: 100px;
  width: 50px;
  background-color:#a6a6a6;
  border:solid 1px #333;
  }

.e {
position: absolute;
left: 8px;
top: 100px;
width: 91px;
height: 50px;
background-color:#808080;
border: solid 1px #333;
}

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

在vba

2 个答案: