使用VBA选择动态范围的单元格并创建图表

时间:2014-08-08 12:55:54

标签: excel vba excel-vba excel-2007

我正在尝试使用VBA使用动态范围创建图表。具体来说,我有一个Excel table如下

Data Table

根据这些数据,我想创建一个图表,根据要求更改日期范围。例如,在一个例子中,我将被要求制作7月1日至7月6日的图表,以及7月10日至7月14日的另一个图表。

以下是我尝试生成这样一个图表,但我觉得除了我的之外会有更好的方法。因此,我的问题是,还有其他更好的方法吗?

1-我首先在'帮助细胞中输入日期值'为此寻找图表。在这种情况下,单元格M24的值为7月10日,而单元格M26的值为7月14日。

2-然后,我使用match()函数从表格的日期列中查找位置。该函数为=MATCH(M24,Table1[Dates],0)=MATCH(M26,Table1[Dates],0)

3-鉴于我有日期的相对位置,我然​​后使用以下VBA代码生成图表:

Private Sub CommandButton1_Click()
    Dim mySheet As Worksheet
    Dim myShape As Shape
    Dim myChart As Chart
    Dim myVal1 As String
    Dim myVal2 As String

    Set mySheet = ActiveWorkbook.Worksheets("dataSheet")
    If myShape Is Nothing Then
        Set myShape = mySheet.Shapes.AddChart(XlChartType:=xlColumnClustered, _
            Left:=CommandButton1.Left + CommandButton1.Width + 2, _
            Width:=370, Height:=200)
    End If

    'In the following, I am offsetting from the first cell
    'of my Table, which contains the `value 1-Jul.
    'My objective is to use the range 10-Jul to 14th Jul,
    'so I also add a column offset
    'Cells O24 and O26 contain the results of the match functions

    myVal1 = Range("B4").Offset(Range("O24").Value, 0).Address
    myVal2 = Range("B4").Offset(Range("O26").Value, 4).Address
    Set myChart = myShape.Chart
    myChart.ChartType = xlLine
    myChart.SetSourceData Source:=Sheets("dataSheet") _
        .Range(CStr(myVal1 & ":" & myVal2))
End Sub

所以,现在希望我的问题很明确,有人可以教我一个比这个更好的方法吗?对我来说,这似乎更像是一种黑客攻击方法而不是正确的编码...

非常感谢提前!

2 个答案:

答案 0 :(得分:2)

在我的教程Chart Partial Range Between Variable Endpoints中,我展示了几个使用已定义名称的替代方案,没有VBA。一种方法是简单地给出要包含在图表中的第一个和最后一个记录的索引,另一个方法是使用匹配来查找在用户输入的日期开始和结束的记录范围。

答案 1 :(得分:1)

正如戴夫所说,这是非常可靠的。但你可以尝试这个:

Private Sub CommandButton1_Click()
    Dim d1 As Range, d2 As Range
    Dim ws As Worksheet: Set ws = Thisworkbook.Sheets("datasheet")
    '~~> Look for the dates
    With ws.Range("Table1[Dates]")
        Set d1 = .Find(ws.Range("M24").Value, .Cells(.Cells.Count))
        Set d2 = .Find(ws.Range("M26").Value, .Cells(.Cells.Count))
    End With
    '~~> Handle unavailable dates, interchanged inputs
    Dim i As Long, j As Long
    If d1 Is Nothing Or d2 Is Nothing Then MsgBox "Invalid coverage": Exit Sub
    If d2.Value > d1.Value Then i = 0: j = 4 Else i = 4: j = 0
    '~~> Set the chart source
    Dim chsource As Range
    Set chsource = ws.ListObjects("Table1").HeaderRowRange
    Set chsource = Union(chsource, ws.Range(d1.Offset(0, i), d2.Offset(0, j)))
    '~~> Clean up existing chart
    Dim sh As Shape
    For Each sh In Me.Shapes
        If sh.Type = msoChart Then sh.Delete
    Next
    '~~> Create the chart
    With Me.Shapes.AddChart(, Me.CommandButton1.Left + _
        Me.CommandButton1.Width + 2, Me.CommandButton1.Top, _
        370, 200).Chart
        .ChartType = xlLine
        .SetSourceData chsource
        .SetElement msoElementChartTitleAboveChart
        .ChartTitle.Text = "Trend Chart"
    End With
End Sub

您仍然分别在M24和M26上检索日期,但不需要在公式中使用其他范围 如果找不到值,则返回一个消息框 只要找到日期,无论用户在何处放置,都会创建图表 我还有两种访问表的方法,一种是使用 Range ,另一种是使用 ListObjects 。 这是故意让你掌握两者。有时一个比另一个好。
此外,我明确使用Me(与包含您的CB的工作表有关) 我还认为你的图表应该有正确的图例而不是Series(x)名称,所以我将标题添加到源代码中。 HTH。