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

Question

我正在尝试使用 VBA 创建使用动态范围的图表。具体来说，我有一个Excel 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

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

非常感谢！

Answer 1

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

Answer 2

正如戴夫所说，它非常可靠。但是你可以试试这个：

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。