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

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

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

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

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

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


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

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

组成结构解析:

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

所需技能分析:

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

关键位置设置展示:

  1. 数据源:

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

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

准时下班系列!Excel合集之第3集—VBA怎么做双条件受控动态图表_Excel_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

学习重难点分析:

  1. VBA基础语法必须要会,还没学完的同学留着学完再看吧
  2. 老师说的在官网查阅API的方法要经常使用
  3. 老师教的调试代码和解决问题的方法着重练习
  4. 充分使用宏录制生成代码的功能,确定大概需要用的对象后,再结合2、3条中提到的API查阅能力和程序调试能力,尝试自己实现指定功能
  5. 上述案例中用到了一个新的对象—Dictionary,先按照下图找到并引用Scripting Runtime库:

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


附上Dictionary对象的API链接:

​https://docs.microsoft.com/zh-cn/office/vba/language/reference/user-interface-help/dictionary-object​


如需系统学习Excel,可查看以下课程:

 https://edu.51cto.com/course/26293.html​

该课程可以使学员以最少的学习时间搭建最完善的表格基础知识架构。


案例文档获取链接:

​https://pan.baidu.com/s/1WKvcfUgfWVn0zlc--_mNuA​

提取码:wmkt