二维码 购物车
部落窝在线教育欢迎您!

用excel制作全国动态疫情地图(VBA篇)

 

作者:E图表述来源:部落窝教育发布时间:2020-02-27 10:38:21点击:10340

分享到:
0
收藏    收藏人气:0人
版权说明: 原创作品,禁止转载。

编按:

除湖北外,全国新冠肺炎新增病例已经降到个位数增长了,国家也鼓励我们有序复工。但是打开手机看到的还是触目惊心的累计确诊图、现有确诊图,并且数据仍然在缓慢的上涨。那我们出门安全吗?什么时候才能不戴口罩出门呢?

 

经过作者和小编的努力,我们得到了全国地级城市的“疫情绿区图”或者说“疫情消退图”。在这些图上,我们可以一眼看出自己所在地或者要去的地方已经多久没有新增病例了。

 



 

通过这张图,我们发现,疫情正在从让人担心的红色、橙色减退为安全的绿色。全国绝大部分地区都已经变成不同程度的绿色,连续14天及以上没有新增病历的深绿区域也已经很多了。

 

我们放大显示了部分省份的疫情绿区图,为大家的安全出行提供一份参考。

 

 

下面我们来看看是怎么得到这些绿区图的,并且分析何时才能像以前一样不戴口罩就可以出门。

 

【前言】

 

考虑了很久,还是决定写下这篇文章,相对于EXCEL教程类的文章来说,无论是函数型、总结型,甚至是VBA教程、BI教程,我们都可以写出很多的内容,可是今天我要分享的教程却是相当麻烦但是又写不出多少内容的文章。


 

“数据地图是很多行业领域都需要的,但是要把它做好却并不容易,难度系数:中,复杂系数:高!在全国一盘棋的抗疫战略中,我们部落窝总觉得应该做点什么来表示我们也是这其中的一份子,所以作者E图表述还是将这个图做了出来,希望用我们EXCELER的特有方式来为这次战疫奉献我们特有的力量。

 

【正文】

 


一、疫情绿区图创建

 


VBA中,SHAPE是图形,数据地图就是利用对于自选图形的属性编辑,达到我们需要的效果,首先我们要有一份可编辑的中国各省地级城市的地图矢量图,这个大家可以加入部落窝的大家庭,向老师索取。

 

STEP 1:处理图形

 

 

这个地图已经被作者处理过了,主要有两方面的处理:

 

1.给每一个图形添加名称。

 

 

选中图形,对照地图,在名称框中输入城市或者区域的名称。

 

2.定位所有对象,调整图形标签的格式。

 

按键盘上的F5键,弹出“定位”窗口,依次点击“定位条件——对象——确定。”

 

 

在选中所有图形后,按照下面的格式调整图形样式。

 

 

图形的设置就到这里了,我们可以得到下面的图,接下来我们再对数据进行处理。

 

 

STEP 2:处理数据

 

VBA虽然强大,但是我们没有必要将所有的东西都用VBA来处理,所以我们把数据处理的部分交给了函数

 

首先我们依然是需要数据源的,在工作中,也是如此。我们这些EXCELER操作的是EXCEL,操作的是数据;手里没有数据谈何技巧的发挥,而在作者的认知中,一直觉得,数据源整理也应该算是学习EXCEL的基础之一。

 

数据来源:今日头条抗击肺炎专题版块

 

然后按下面的结构处理数据,便于我们代码的引用。

 

 

G2单元格输入函数:

=MAX(A:A)

 

H2单元格输入函数:

=MAX(A:A)-MIN(A:A)+1

 

G4单元格输入函数,并下拉填充:

=IF(C4<>C3,D4,D4-D3)

 

H4单元格输入函数,并下拉填充:

{=IF(A4<>$G$2,0,LOOKUP(9^9,N(FREQUENCY(IF(OFFSET(G4,0,0,-$H$2,1)=0,ROW(INDIRECT("$4:$" & $H$2+3))),IF(OFFSET(G4,0,0,-$H$2,1)<>0,ROW(INDIRECT("$4:$" & $H$2+3)))))))}

 

H4单元格的函数,用于统计截止224日,最后一次每日新增量连续为0的次数。当然,这不是今天的重点,大家可以先使用“拿来主义,以后我们肯定会讲这个内容。

 

处理完数据,我们再建立一张空白工作表,在A1单元格输入:城市名称,B1单元格输入:数据。讲到这里,同学们知道我们一共有几张工作表吗?一共四张,如下命名:

 

 

STEP 3:输入VBA代码

 

ALT+F11组合键,打开VBE界面,录入第一段代码,工程名称:填充图形颜色

 

Sub 填充图形颜色()

  Dim i As Integer, a As String

  Dim rg As Range

  On Error Resume Next

  With ActiveSheet

    a = .[C1]

    For Each rg In .Range("B2:B" & .[B65000].End(3).Row) '在《图表数据》B列中循环每一个单元格

      i = Application.Match(rg.Value, [C:C], 1) '确定每个值,在某个区间

      ActiveSheet.Shapes(rg.Offset(0, -1).Value).Fill.ForeColor.RGB = Cells(i, "A").Interior.Color '按照区间对应的色阶,填充图形颜色

      ActiveSheet.Shapes(rg.Offset(0, -1).Value).TextFrame2.TextRange.Characters.Text = rg.Offset(0, -1).Value & Chr(10) & rg.Value & a '给图形的标签赋值为城市名称+数值+单位的形式

    Next rg

  End With

End Sub

 

因为我们做的是模板,所以同学们可以直接使用数据源,不需要更改代码。如有想学习代码的同学,可以参考作者为代码添加的批注说明。

 

因为作者要将各种数据统计在一张地图中标记,所以我们还要做4段代码,分别是累计确诊病例现有确诊病例今日新增病例连续零增加病例。代码的结构都是一样的,我们用其中的连续零增加病例代码列出范例如下。

 

Sub 连续0增长病例()

   With Sheets("数据分析图")

    .[A26].Interior.Color = RGB(249, 83, 77) '以下6行代码,是设置色阶的RGB代码

    .[A27].Interior.Color = RGB(197, 208, 112)

    .[A28].Interior.Color = RGB(165, 199, 112)

    .[A29].Interior.Color = RGB(119, 185, 113)

    .[A30].Interior.Color = RGB(76, 172, 113)

    .[A31].Interior.Color = RGB(10, 154, 114)

   

    .[B26] = "0-2天无新增" '以下6行代码,是区间值的说明

    .[B27] = "3-4天无新增"

    .[B28] = "5-6天无新增"

    .[B29] = "7-9天无新增"

    .[B30] = "10-13天无新增"

    .[B31] = "≥14天无新增"

   

    .[C26] = 0 '以下6行代码,是确定色阶的辅助列,工作表中改成白色

    .[C27] = 3

    .[C28] = 5

    .[C29] = 7

    .[C30] = 10

    .[C31] = 14

  End With

  Dim a As Integer, i As Integer

  Dim arr, d

  With Sheets("源数据")

    a = .Range("A3").End(4).Row '确定源数据的末行,并赋值给变量a

    arr = .Range("A4:I" & a) '将动态数据区域,赋值给数组

  End With

  Set d = CreateObject("scripting.dictionary") '建立字典脚本

  For i = 1 To UBound(arr) '循环数组

    d(arr(i, 3)) = arr(i, 8) '将最后一次的数值赋值给字典

  Next i

 

  Sheets("数据分析图").[C1] = "地级城市:连续零增加病例天数分布图" '确定图表标题

  With Sheets("图表数据")

    .Range("A2").Resize(d.Count, 1) = Application.Transpose(d.keys) '将字典的关键字赋值到《图表数据》的A

    .Range("B2").Resize(d.Count, 1) = Application.Transpose(d.items) '将字典的项赋值到《图表数据》的B

    .Range("C1") = "" '标注单位

  End With

  Call 填充图形颜色 '引用填充图形颜色的工程

  [A1].Select '定位最后的光标

  Erase arr

  Set d = Nothing

End Sub

 

关于其他三段代码,大家可以尝试着自己操作,当然也可以加入部落窝的学习QQ群,下载素材学习。

 

STEP 4:添加控件并加载宏

 

首先我们添加控件,依次点击“工具栏——开发工具——插入——选项按钮。”

 

 

鼠标右键点击控件,点击编辑文字,依次修改控件的标签。

 

 

看到上图中指定宏的选项了吗,点击它就可以加载我们刚才写的代码了。

 

 

这些就是我们做的工程名称,选择对应的名称再点击确定,就可以将代码加载到控件上,点击控件的过程也就是激活此工程代码的过程。藉此完成。

 

STEP 5:衍生出各省地图

 

我们已经做出了大部分的地图,那么如果能从这个全国地图中,再看到各省的地级城市地图不是更加方便?下面我们就来看一下如何“根据全国地图制作各省地图,以四川为例:

 

步骤1

 

在《行政区域图》中按住CTRL键复选你要的省份的城市拼图,复制到一个新的工作表,将工作表名称命名为某省。

 

 

步骤2

 

在《数据分析图》中复制出“色阶区间区域A25:B31”、“标题选择控件,并将其一并粘贴到《四川省》工作表中,形成下图的布局。

 

 

因为我们是复制过来的,所以控件上依然有代码加载,可以直接操作,无需再重新加载。

 

步骤3

 

VBE代码中,录入下面的代码:

Sub 四川()

  Sheets("四川省").Select

End Sub

 

步骤4

 

再次回到《数据分析图》工作表,复选四川省的各城市拼图,单击鼠标右键,在弹出的菜单中选择指定宏,选择四川,点击“确定”。此时,我们再点击这些拼图的时候,就可以链接到《四川》这个工作表中了。

 

步骤5

 

按照上面的操作,依次制作出《武汉》、《广东》两个工作表,然后按住CTRL键,复选《武汉》、《四川》、《广东》三个工作表,在A1单元格中输入返回全国图,单击鼠标右键,在菜单中选择超链接选择项,设置链接到《数据分析图》工作表,藉此我们整体的一个地图就完成了,有兴趣的同学可以自己制作自己省份的地图。

 

下面给大家看几张展示图,记得一定要亲手操作一遍。

 

 

 

 

从图表上来看,疫情的防控工作,我们大中国做的真的很不错,1个月的时间就已经控制到这样的一个程度,说明我们的做法是正确的,身为一位中国EXCELER,我骄傲!!

 

【编后语】

 


二、何时可以不戴口罩了?

 


我们已经得到了全国和各省份的疫情绿区图,这些数据显示绝大多数地区的疫情已经被打败,正在消退,正在远离,超过7天、14天,甚至21天的连续零增加病历的地区越来越多。

 

那何时我们可以不戴口罩出门,可以在公交、地铁上自由呼吸呢?

 

1.中位数分析

 

在我们整理的Excel数据文件中,有一张工作表“图表数据”。这里面统计的是全国各地级市截止224日连续零增加病例的天数。

 

 

我们复制数据列,并去掉湖北的数据,然后进行升序排列,得到321个数据。这些数据中,最小的是0,有11个,最大的是32,有30个。数列的中位数为10。如果我们保守些,按照连续24天(当前最长潜伏期)零增加就视为疫情结束的话,需要14天,也就是310日后,除湖北外,全国绝大多数地区将进入深绿。

 

2.现存确诊的走势分析

 

通过百度APP我们能查到非湖北现存确诊人数图。

 

 

这是一条看起来比较光滑的接近抛物线的图。我们可以在这张图上进行趋势推测,现存确诊归零大约在316日前后。

 

 

3.当前治愈数据的分析

 

我们统计了全国、湖北、非湖北的每日新增治愈。

 

 

很显然,湖北外新增治愈在220日达到最高后开始降低。这个态势是从低到高再到低的走势。截止到225日,非湖北共治愈8830人,每日平均治愈人数约为245全国非湖北现存确诊人数是4037,当前每日新增是个位数,可以不考虑,全部治愈(非湖北死亡很低,所以忽略死亡)需要约16天,也就是到312日前后。

 

4.结论

 

综合前面3项分析,我们预测到3月中旬,全国湖北外的地方疫情就结束了,我们就可以摘掉口罩,自在出门了。当然,如果谨慎的话,需要等到湖北结束,时间还需要延后10~20天,也就是3月底或4月中旬,我们才能摘掉口罩。

当然所有的预测都是建立在我们继续坚持“戴口罩、勤洗手、少聚集”的做法上,所以,在疫情结束前请大家继续坚持!

   最后,我们看看截止到2月26日数据,湖北各地已经有8个地级市没有出现新增病历了!

 


 


 

再次声明:本文只做EXCEL技术交流与分享,对于数据内容正误,请以国家官方发布信息为准。

 

本文配套的练习课件请加入QQ群:747953401下载。

Excel高手,快速提升工作效率,部落窝教育《一周Excel直通车》视频和《Excel极速贯通班》直播课全心为你!

扫下方二维码关注公众号,可随时随地学习Excel

IMG_256

相关推荐:

疫情动态图新冠肺炎最新走势情况,一张excel动态图带你看清!(截止2020-02-11

疫情动态组合图新冠肺炎:“累计确诊病例”动态excel组合图

excel制作波浪图疫情过后最想做的10件事是啥?可爱的excel波浪图给你答案!

使用切片器制作动态图《光涨肉价,不涨工资?用excel做张老板最爱的自动化表格,让你的工资翻一番!》