准时下班系列！Excel合集之第3集—VBA怎么做双条件受控动态图表

Posted 2021-12-24 吴明课堂

tags:

篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了准时下班系列！Excel合集之第3集—VBA怎么做双条件受控动态图表相关的知识，希望对你有一定的参考价值。

Hi，各位同学好！我是吴明课堂的答疑老师之一陈婉。

最近有位勇敢又特别聪明的学员，零基础学了几天（非夸张量词）Excel之后，成功应聘到了一家连锁企业做了仓管。

初生牛犊不怕虎，她对领导做了很多承诺。但学的时间特别短，基础不牢固，经常不记得功能在课程的哪个位置，所以最近跟我沟通比较多。

前两天问我动态图表咋做，我给她截图了老师在Excel教程第11章讲的动态图表相关课程位置，她照着做了一个，又提出了新的需求：老师讲的例子只有一个条件会变动，她想要加一个条件，希望能在图表中选择显示前N项数据。

于是我们俩一拍即合，迅速确定了这周的文章内容：

准时下班系列！Excel合集之第3集—VBA怎么做双条件受控动态图表_动态图表

首先给大家演示下最终效果：

准时下班系列！Excel合集之第3集—VBA怎么做双条件受控动态图表_VBA_02

组成结构解析：

数据源区域（文档取自吴明老师的《Excel综合进阶课程》动态图表案例）
图表控制条件区域（在老师的课件上添加了一个条件选择框—C13）
图表区域（原版课件，未作改动）
VBA程序

所需技能分析：

数据验证相关知识（做下拉框）
单元格式设置相关知识（影响C13单元格的显示内容）
图表相关基础知识
VBA编程知识（基础语法+API查阅能力）

关键位置设置展示：

数据源：

准时下班系列！Excel合集之第3集—VBA怎么做双条件受控动态图表_图表_03

2. C13自定义单元格格式设置：

准时下班系列！Excel合集之第3集—VBA怎么做双条件受控动态图表_图表_04

3. VBA代码（写在工作表对象内）：

用户更改工作表单元格(不包含重新计算事件)时触发
Private Sub Worksheet_Change(ByVal Target As Range)
    If (Target.Address = "$B$13" Or Target.Address = "$C$13") Then
        Call reDoChart
    End If
End Sub
更改图表
Private Function reDoChart()
    Dim dataArr(), total As Integer, i As Integer
    根据条件获取图表数据源
    dataArr = getDataByCondition()
    total = UBound(dataArr)
    拆分图表数据源
    Dim nameArr(), valueArr()
    nameArr = dataArr
    valueArr = dataArr
    For i = 0 To total
        Dim conArr() As String
        conArr = VBA.Split(dataArr(i), ";")
        nameArr(i) = conArr(0)
        valueArr(i) = VBA.CDbl(conArr(1))
    Next i
    设置图表数据源
    Dim cot As ChartObject
    For Each cot In Sheets("Sheet1").ChartObjects
        cot.Chart.FullSeriesCollection(1).Name = [B13]
        cot.Chart.FullSeriesCollection(1).Values = valueArr
        cot.Chart.FullSeriesCollection(1).XValues = nameArr
    Next cot
End Function
根据B13、C13获取图表数据源
Private Function getDataByCondition() As Variant
    Dim month As String, topN As Integer
    Dim titlerngs As Range, titleRng As Range, dataRngs As Range
    month = [B13]
    topN = [C13]
    月份标题区域
    Set titlerngs = Range("B5:H5")
    Set titleRng = titlerngs.Find(month)
    If (titleRng Is Nothing) Then
        MsgBox "请检查数据"
        Exit Function
    End If
    数据区域
    Set dataRngs = Range(titleRng.Offset(1, 0), titleRng.End(xlDown))
    给数据区域排名，并返回排名后的区域
    getDataByCondition = getRankData(dataRngs, topN)
End Function
给单元格排序的函数，并返回前N项数据
Private Function getRankData(dataRngs As Range, topN As Integer) As Variant
    容错处理
    If (topN > dataRngs.Count) Then
        MsgBox "数据有误，请检查"
        Exit Function
    End If
    需引用Microsoft Scripting Runtime
    Dim sourcedic As New Dictionary
    Dim rng As Range
    单元格区域放进Dictionary中
    For Each rng In dataRngs
        sourcedic.Add Cells(rng.Row, 2).Value, rng.Value
    Next rng
    排序后的字典对象
    Dim rankedDic As New Dictionary
    Dim i As Integer, j As Integer, index As String, max As Double
    For i = 1 To topN
        index = sourcedic.Keys(0)
        max = sourcedic.Items(0)
        For j = 0 To sourcedic.Count - 1
            If (sourcedic.Items(j) >= max) Then
                index = sourcedic.Keys(j)
                max = sourcedic.Items(j)
            End If
        Next j
        rankedDic.Add index, index & ";" & max
        sourcedic.Remove index
    Next i
    getRankData = rankedDic.Items
End Function