二維碼 購物車
部落窩在線教育歡迎您!

用excel制作全國動態(tài)疫情地圖(VBA篇)

?

作者:E圖表述來源:部落窩教育發(fā)布時間:2020-02-27 10:38:21點擊:10913

分享到:
0
收藏    收藏人氣:0人
版權說明: 原創(chuàng)作品,禁止轉載。

編按:

除湖北外,全國新冠肺炎新增病例已經降到個位數增長了,國家也鼓勵我們有序復工。但是打開手機看到的還是觸目驚心的累計確診圖、現有確診圖,并且數據仍然在緩慢的上漲。那我們出門安全嗎?什么時候才能不戴口罩出門呢?

 

經過作者和小編的努力,我們得到了全國地級城市的“疫情綠區(qū)圖”或者說“疫情消退圖”。在這些圖上,我們可以一眼看出自己所在地或者要去的地方已經多久沒有新增病例了。

 



 

通過這張圖,我們發(fā)現,疫情正在從讓人擔心的紅色、橙色減退為安全的綠色。全國絕大部分地區(qū)都已經變成不同程度的綠色,連續(xù)14天及以上沒有新增病歷的深綠區(qū)域也已經很多了。

 

我們放大顯示了部分省份的疫情綠區(qū)圖,為大家的安全出行提供一份參考。

 

 

下面我們來看看是怎么得到這些綠區(qū)圖的,并且分析何時才能像以前一樣不戴口罩就可以出門。

 

【前言】

 

考慮了很久,還是決定寫下這篇文章,相對于EXCEL教程類的文章來說,無論是函數型、總結型,甚至是VBA教程、BI教程,我們都可以寫出很多的內容,可是今天我要分享的教程卻是相當麻煩但是又寫不出多少內容的文章。


 

“數據地圖是很多行業(yè)領域都需要的,但是要把它做好卻并不容易,難度系數:中,復雜系數:高!在全國一盤棋的抗疫戰(zhàn)略中,我們部落窩總覺得應該做點什么來表示我們也是這其中的一份子,所以作者E圖表述還是將這個圖做了出來,希望用我們EXCELER的特有方式來為這次戰(zhàn)疫奉獻我們特有的力量。

 

【正文】

 


一、疫情綠區(qū)圖創(chuàng)建

 


VBA中,SHAPE是圖形,數據地圖就是利用對于自選圖形的屬性編輯,達到我們需要的效果,首先我們要有一份可編輯的中國各省地級城市的地圖矢量圖,這個大家可以加入部落窩的大家庭,向老師索取。

 

STEP 1:處理圖形

 

 

這個地圖已經被作者處理過了,主要有兩方面的處理:

 

1.給每一個圖形添加名稱。

 

 

選中圖形,對照地圖,在名稱框中輸入城市或者區(qū)域的名稱。

 

2.定位所有對象,調整圖形標簽的格式。

 

按鍵盤上的F5鍵,彈出“定位”窗口,依次點擊“定位條件——對象——確定?!?/span>

 

 

在選中所有圖形后,按照下面的格式調整圖形樣式。

 

 

圖形的設置就到這里了,我們可以得到下面的圖,接下來我們再對數據進行處理。

 

 

STEP 2:處理數據

 

VBA雖然強大,但是我們沒有必要將所有的東西都用VBA來處理,所以我們把數據處理的部分交給了函數。

 

首先我們依然是需要數據源的,在工作中,也是如此。我們這些EXCELER操作的是EXCEL,操作的是數據;手里沒有數據談何技巧的發(fā)揮,而在作者的認知中,一直覺得,數據源整理也應該算是學習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單元格的函數,用于統(tǒng)計截止224日,最后一次每日新增量連續(xù)為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列中循環(huán)每一個單元格

      i = Application.Match(rg.Value, [C:C], 1) '確定每個值,在某個區(qū)間

      ActiveSheet.Shapes(rg.Offset(0, -1).Value).Fill.ForeColor.RGB = Cells(i, "A").Interior.Color '按照區(qū)間對應的色階,填充圖形顏色

      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

 

因為我們做的是模板,所以同學們可以直接使用數據源,不需要更改代碼。如有想學習代碼的同學,可以參考作者為代碼添加的批注說明。

 

因為作者要將各種數據統(tǒng)計在一張地圖中標記,所以我們還要做4段代碼,分別是累計確診病例、現有確診病例、今日新增病例、連續(xù)零增加病例。代碼的結構都是一樣的,我們用其中的連續(xù)零增加病例代碼列出范例如下。

 

Sub 連續(xù)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行代碼,是區(qū)間值的說明

    .[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) '將動態(tài)數據區(qū)域,賦值給數組

  End With

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

  For i = 1 To UBound(arr) '循環(huán)數組

    d(arr(i, 3)) = arr(i, 8) '將最后一次的數值賦值給字典

  Next i

 

  Sheets("數據分析圖").[C1] = "地級城市:連續(xù)零增加病例天數分布圖" '確定圖表標題

  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:添加控件并加載宏

 

首先我們添加控件,依次點擊“工具欄——開發(fā)工具——插入——選項按鈕?!?/span>

 

 

鼠標右鍵點擊控件,點擊編輯文字,依次修改控件的標簽。

 

 

看到上圖中指定宏的選項了嗎,點擊它就可以加載我們剛才寫的代碼了。

 

 

這些就是我們做的工程名稱,選擇對應的名稱再點擊確定,就可以將代碼加載到控件上,點擊控件的過程也就是激活此工程代碼的過程。藉此完成。

 

STEP 5:衍生出各省地圖

 

我們已經做出了大部分的地圖,那么如果能從這個全國地圖中,再看到各省的地級城市地圖不是更加方便?下面我們就來看一下如何“根據全國地圖制作各省地圖,以四川為例:

 

步驟1

 

在《行政區(qū)域圖》中按住CTRL鍵復選你要的省份的城市拼圖,復制到一個新的工作表,將工作表名稱命名為某省。

 

 

步驟2

 

在《數據分析圖》中復制出“色階區(qū)間區(qū)域A25:B31”、“標題、選擇控件,并將其一并粘貼到《四川省》工作表中,形成下圖的布局。

 

 

因為我們是復制過來的,所以控件上依然有代碼加載,可以直接操作,無需再重新加載。

 

步驟3

 

VBE代碼中,錄入下面的代碼:

Sub 四川()

  Sheets("四川省").Select

End Sub

 

步驟4

 

再次回到《數據分析圖》工作表,復選四川省的各城市拼圖,單擊鼠標右鍵,在彈出的菜單中選擇指定宏,選擇四川,點擊“確定”。此時,我們再點擊這些拼圖的時候,就可以鏈接到《四川》這個工作表中了。

 

步驟5

 

按照上面的操作,依次制作出《武漢》、《廣東》兩個工作表,然后按住CTRL鍵,復選《武漢》、《四川》、《廣東》三個工作表,在A1單元格中輸入返回全國圖,單擊鼠標右鍵,在菜單中選擇超鏈接選擇項,設置鏈接到《數據分析圖》工作表,藉此我們整體的一個地圖就完成了,有興趣的同學可以自己制作自己省份的地圖。

 

下面給大家看幾張展示圖,記得一定要親手操作一遍。

 

 

 

 

從圖表上來看,疫情的防控工作,我們大中國做的真的很不錯,1個月的時間就已經控制到這樣的一個程度,說明我們的做法是正確的,身為一位中國EXCELER,我驕傲?。?/span>

 

【編后語】

 


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

 


我們已經得到了全國和各省份的疫情綠區(qū)圖,這些數據顯示絕大多數地區(qū)的疫情已經被打敗,正在消退,正在遠離,超過7天、14天,甚至21天的連續(xù)零增加病歷的地區(qū)越來越多。

 

那何時我們可以不戴口罩出門,可以在公交、地鐵上自由呼吸呢?

 

1.中位數分析

 

在我們整理的Excel數據文件中,有一張工作表“圖表數據”。這里面統(tǒng)計的是全國各地級市截止224日連續(xù)零增加病例的天數。

 

 

我們復制數據列,并去掉湖北的數據,然后進行升序排列,得到321個數據。這些數據中,最小的是0,有11個,最大的是32,有30個。數列的中位數為10。如果我們保守些,按照連續(xù)24天(當前最長潛伏期)零增加就視為疫情結束的話,需要14天,也就是310日后,除湖北外,全國絕大多數地區(qū)將進入深綠。

 

2.現存確診的走勢分析

 

通過百度APP我們能查到非湖北現存確診人數圖。

 

 

這是一條看起來比較光滑的接近拋物線的圖。我們可以在這張圖上進行趨勢推測,現存確診歸零大約在316日前后。

 

 

3.當前治愈數據的分析

 

我們統(tǒng)計了全國、湖北、非湖北的每日新增治愈。

 

 

很顯然,湖北外新增治愈在220日達到最高后開始降低。這個態(tài)勢是從低到高再到低的走勢。截止到225日,非湖北共治愈8830人,每日平均治愈人數約為245。全國非湖北現存確診人數是4037,當前每日新增是個位數,可以不考慮,全部治愈(非湖北死亡很低,所以忽略死亡)需要約16天,也就是到312日前后。

 

4.結論

 

綜合前面3項分析,我們預測到3月中旬,全國湖北外的地方疫情就結束了,我們就可以摘掉口罩,自在出門了。當然,如果謹慎的話,需要等到湖北結束,時間還需要延后10~20天,也就是3月底或4月中旬,我們才能摘掉口罩。

當然所有的預測都是建立在我們繼續(xù)堅持“戴口罩、勤洗手、少聚集”的做法上,所以,在疫情結束前請大家繼續(xù)堅持!

   最后,我們看看截止到2月26日數據,湖北各地已經有8個地級市沒有出現新增病歷了!

 


 


 

再次聲明:本文只做EXCEL技術交流與分享,對于數據內容正誤,請以國家官方發(fā)布信息為準。

 

本文配套的練習課件請加入QQ群:747953401下載。

Excel高手,快速提升工作效率,部落窩教育《一周Excel直通車》視頻和《Excel極速貫通班》直播課全心為你!

掃下方二維碼關注公眾號,可隨時隨地學習Excel

IMG_256

相關推薦:

疫情動態(tài)圖新冠肺炎最新走勢情況,一張excel動態(tài)圖帶你看清?。ń刂?020-02-11

疫情動態(tài)組合圖新冠肺炎:“累計確診病例”動態(tài)excel組合圖

excel制作波浪圖疫情過后最想做的10件事是啥?可愛的excel波浪圖給你答案!

使用切片器制作動態(tài)圖《光漲肉價,不漲工資?用excel做張老板最愛的自動化表格,讓你的工資翻一番!》