union all动态表_Excel VBA——动态显示图表

本文讲述将柱形图和折线图做成动态图表的方法。所谓动态是指鼠标点到哪个单元格，就显示活动单元格所在列或行的图表，其中折线图可以让数据点依次显示，使得整个图表不再死板，像变了一样！在开始之前，需要先介绍VBA中的一个概念：事件。

事件

VBA中的事件可以理解为一种触发开关，某些对象有对应的事件开关，一旦对象识别了事件动作，就会自动执行事件过程中的程序。比如，一旦打开某个工作簿，就怎么样，一旦工作表中单元格被更改，就怎么样，等等，都是一个事件。要写关于某个对象的事件过程，就必须打开该对象所在模块，并打开该模块的代码窗口进行程序编写。只有将事件过程写在对应的模块中，程序才能自动触发。在代码窗口的列表框和列表框中选择相应的对象和事件名称，完成选择后，代码窗口会自动生成事件过程的头部代码。当然，熟练后这两行代码也可以自己直接编写，但必须要保证和自动生成的完全一致。

图1 列表框

图2 列表框

示例数据源

表1 示例数据源

动态柱形图

根据表1的示例数据源创建一个簇状柱形图表，在图表中动态显示活动单元格所在列的设计方案数据。代码分享

Option ExplicitPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)        '工作表单元选择改变触发的事件过程    Application.ScreenUpdating = False    Application.DisplayAlerts = False    Dim chtchart As ChartObject    Dim rngrange As Range, lngc As Long    Dim sourange As Range    Dim sngleft As Single, sngtop As Single    sngleft = Range("G5").Left    sngtop = Range("G5").Top       On Error Resume Next    Set rngrange = Application.Intersect(ActiveCell, Range("B1:F5"))        '判断活动单元格与数据区域是否有交集    If Not rngrange Is Nothing Then     '如果有交集，执行以下程序        lngc = ActiveCell.Column        '提取活动单元格所在列号        Set sourange = Application.Union(Range("A2:A5"), Range(Cells(2, lngc), Cells(5, lngc)))     '通过Union合并画图区域数据        ChartObjects.Delete     '删除已有图表        Set chtchart = ChartObjects.Add(sngleft, sngtop, 400, 250)      '新建图表        With chtchart.Chart            .SetSourceData Source:=sourange, PlotBy:=xlColumns            .ChartType = xlColumnClustered            .ApplyDataLabels            .HasTitle = True            .HasLegend = False            .ChartTitle.Text = Cells(1, lngc)            With .Axes(xlValue, xlPrimary)                .HasTitle = True                .AxisTitle.Text = "流量/L·min-1"                .AxisTitle.Font.Size = 12            End With        End With    End If    Set rngrange = Nothing    Set sourange = Nothing    Set chtchart = Nothing    Application.ScreenUpdating = True    Application.DisplayAlerts = TrueEnd Sub

运行效果

图3 动态柱形图

动态折线图

将折线图上的每个数据点动态显示出来，可以更加直观地感受数据的变化趋势。

代码分享

Option ExplicitPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)    Dim chtchart As ChartObject    Dim rngrange As Range, lngrow As Long    Dim sourange As Range    Dim sngleft As Single, sngtop As Single    Dim i As Integer    sngleft = Range("G5").Left    sngtop = Range("G5").Top        On Error Resume Next    ChartObjects.Delete    Set rngrange = Application.Intersect(ActiveCell, Range("A2:F5"))    If Not rngrange Is Nothing Then        lngrow = ActiveCell.Row        Set chtchart = ChartObjects.Add(sngleft, sngtop, 400, 250)        Set sourange = Application.Union(Range("B1:F1"), Range("B" & lngrow, "F" & lngrow))        With chtchart.Chart            .SetSourceData Source:=sourange, PlotBy:=xlRows            .ChartType = xlLine            .ApplyDataLabels            .HasTitle = True            .HasLegend = False            .ChartTitle.Text = Cells(lngrow, 1)            With .SeriesCollection(1)                .MarkerStyle = xlMarkerStyleCircle                .MarkerSize = 8            End With            With .Axes(xlValue, xlPrimary)                .HasTitle = True                .AxisTitle.Text = "流量/L·min-1"                .AxisTitle.Font.Size = 12            End With        End With        For i = 1 To 5            chtchart.Chart.SeriesCollection(1).Values = Range("B" & lngrow).Resize(1, i)            delay 0.5        Next    End If    Set rngrange = Nothing    Set sourange = Nothing    Set chtchart = NothingEnd Sub'delay过程定义Sub delay(t As Single)    Dim t1 As Single    t1 = Timer    Do        DoEvents    Loop While Timer - t1 < tEnd Sub

运行效果