如何将Excel图表源数据与下拉框选定的日期范围关联？

核心思路：利用Excel表格（ListObject）的筛选功能+图表动态引用 #

直接用表格自带的筛选匹配日期范围，比手动遍历更高效，还能自动适配数据更新。以下是具体实现步骤：

步骤1：基础配置说明 #

假设：

• Report工作表的开始日期下拉框在A1，结束日期在B1
• Database工作表的表格名为Table1，包含Date（日期列）和FeedTonnage（数据列）
• Report中的目标图表名为Chart1

步骤2：VBA核心代码实现 #

Sub UpdateChartByDateRange()
    Dim wsReport As Worksheet, wsDB As Worksheet
    Dim tblDB As ListObject
    Dim startDate As Date, endDate As Date
    Dim chartObj As ChartObject
    
    ' 初始化工作表与表格对象
    Set wsReport = ThisWorkbook.Worksheets("Report")
    Set wsDB = ThisWorkbook.Worksheets("Database")
    Set tblDB = wsDB.ListObjects("Table1")
    Set chartObj = wsReport.ChartObjects("Chart1")
    
    ' 获取用户选择的日期范围
    On Error Resume Next
    startDate = wsReport.Range("A1").Value
    endDate = wsReport.Range("B1").Value
    On Error GoTo 0
    
    ' 校验日期有效性
    If IsEmpty(startDate) Or IsEmpty(endDate) Or startDate > endDate Then
        MsgBox "请选择有效的日期范围（开始日期≤结束日期）", vbExclamation
        Exit Sub
    End If
    
    ' 清除表格原有筛选
    If tblDB.AutoFilter.FilterMode Then tblDB.AutoFilter.ShowAllData
    
    ' 对Date列应用日期范围筛选
    tblDB.ListColumns("Date").Range.AutoFilter _
        Field:=1, _
        Criteria1:=">=" & CLng(startDate), _
        Criteria2:="<=" & CLng(endDate), _
        Operator:=xlAnd
    
    ' 更新图表数据源为筛选后的表格数据
    With chartObj.Chart
        .SetSourceData Source:=tblDB.DataBodyRange.SpecialCells(xlCellTypeVisible)
        ' 明确指定X/Y轴数据源
        .SeriesCollection(1).XValues = tblDB.ListColumns("Date").DataBodyRange.SpecialCells(xlCellTypeVisible)
        .SeriesCollection(1).Values = tblDB.ListColumns("FeedTonnage").DataBodyRange.SpecialCells(xlCellTypeVisible)
    End With
End Sub

步骤3：绑定下拉框触发事件 #

在Report工作表的代码模块中添加以下代码，让用户选择日期后自动更新图表：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅当日期下拉框（A1/B1）内容变化时触发更新
    If Not Intersect(Target, Me.Range("A1:B1")) Is Nothing Then
        UpdateChartByDateRange
    End If
End Sub

替代方案：手动遍历表格行（无需筛选场景） #

如果必须手动遍历日期列匹配范围，可使用以下代码，避免单元格地址替换的麻烦：

Sub UpdateChartByLoop()
    Dim wsReport As Worksheet, wsDB As Worksheet
    Dim tblDB As ListObject
    Dim startDate As Date, endDate As Date
    Dim xData As Variant, yData As Variant
    Dim i As Long, count As Long
    
    Set wsReport = ThisWorkbook.Worksheets("Report")
    Set wsDB = ThisWorkbook.Worksheets("Database")
    Set tblDB = wsDB.ListObjects("Table1")
    
    startDate = wsReport.Range("A1").Value
    endDate = wsReport.Range("B1").Value
    
    ' 初始化数组存储匹配数据
    ReDim xData(1 To tblDB.ListRows.Count)
    ReDim yData(1 To tblDB.ListRows.Count)
    count = 0
    
    ' 遍历表格每一行
    For i = 1 To tblDB.ListRows.Count
        With tblDB.ListRows(i)
            If .Range(tblDB.ListColumns("Date").Index).Value >= startDate And _
               .Range(tblDB.ListColumns("Date").Index).Value <= endDate Then
                count = count + 1
                xData(count) = .Range(tblDB.ListColumns("Date").Index).Value
                yData(count) = .Range(tblDB.ListColumns("FeedTonnage").Index).Value
            End If
        End With
    Next i
    
    ' 更新图表数据
    If count > 0 Then
        ReDim Preserve xData(1 To count)
        ReDim Preserve yData(1 To count)
        With wsReport.ChartObjects("Chart1").Chart.SeriesCollection(1)
            .XValues = xData
            .Values = yData
        End With
    Else
        MsgBox "该日期范围内无匹配数据", vbInformation
    End If
End Sub

关键注意事项 #

• 确保Database中的日期列格式与Report下拉框的日期格式一致，避免匹配错误
• 使用表格（ListObject）后，新添加的数据会自动纳入表格范围，无需手动调整数据源
• 若图表初始无数据，需先手动添加一个数据系列，否则VBA中SeriesCollection(1)会报错

内容的提问来源于stack exchange，提问作者jesuslovesyou