当前位置：首页>Excel>手把手教你用EXCEL手搓一个春晚收视率数据地图?地图根据数据自动变化!

手把手教你用EXCEL手搓一个春晚收视率数据地图?地图根据数据自动变化!

2026-04-06 12:18:34

2026央视马年春晚收视率又是被东北三省占前三甲，从全国各省收视率看，辽宁稳稳拿第一收视率为93.31%，黑龙江即使有分会场也是第二收视率为91.11%，吉林第三90.47%。

除了前三名，后三甲，华南F3（广东、广西、海南）依旧稳坐泰山，坐稳最后三名。很多人调侃广西人为什么不看春晚，过年干嘛去了？

不是不看，都在这看呢，村里只有一台“电视”，挤都挤不进去。

好了，不开玩笑！言归正传，像这样一个随着数据颜色变动的地图，怎么做呢？

接下来，我们一步步教大家如何做。建议点赞收藏一下，避免以后需要时找不到了。

一、制作教程

制作过程可能有点麻烦复杂，感兴趣的小伙伴需要认真看完学习，不感兴趣或看完没学会的，文章最后有全套模版获取方式：1张全国地图+34张省市细分地图，直接下载更新数据套用即可。

第一步，去网上找一下收视率数据，做一个EXCEL数据表，罗列各省市比例，并分好等级

数据的分级，大家可以根据自己的需求定义。

第二步，去网上找一份全国地图。要是矢量地图，可以拆分成各省市形状的。

推荐一个网站：

https://datav.aliyun.com/portal/school/atlas/area_selector

找到全国范围的地图后，点下载

第三步，将第二步下载的地图，以图片形式插入到EXCEL中

插入到EXCEL中后，右键-转换为形状

转换成形状后，就可以单独选中省市进行编辑了。

第四步，给各个省市地图形状命名

单独选中省市对应的小地图形状，在EXCEL左上角名称框中，按第一步EXCEL数据表的名称命名

如果你想在地图上也显示文字，右键也可以加上文字

这一步比较麻烦，需要用鼠标很小心的一个个行政省市小形状地图选中，一个个命名，如果只需要做一个全国地图，只有34个省市形状，也不算太多，一个个命名就行。

如果需要做34个省市细分到城市的地图，就比较麻烦了，全国约700个城市，一个个选中命名，工作量非常大。这时就需要借助VBA批量处理，有点复杂，这里不细说。

第五步，根据数据大小，给地图填充对应颜色。

这一步，如果数据是固定不变的，可以选择手动填充。也就是像上一步一样，一个个省市小地图选中，单独填充颜色。

这种情况，只适用数据固定不变的情况，如果数据变动了，颜色不会自动更新。

如果想颜色随着数据变动，批量自动更新，我们需要借助VBA。

在数据等级表中，设置每个等级对应的单元格颜色，VBA代码将根据单元格颜色对应的等级，自动填充到对应省市地图中。

VBA代码我放在文章最后，完成后效果如下：

你学会了吗？

这个地图，不仅可以统计春晚收视率哦，也可以统计公司在全国业务数据的分布情况。把业务数据更新到数据区域，就可以换成你的业务数据地图了。

二、如何获取全套地图模版？

如果看完还是学不会，太复杂嫌麻烦，关注公众号，回消息：地图，可下载全套VBA自动化地图模版：

含1张全国地图+34张省市地图，共35个地图；
1全国地图，具体到省、自治区、直辖市，特别行政区，34张省市地图，省、自治区可细分到700个城市，直辖市细分到市里的行政区；
更新数据和颜色即可变成自己的数据地图，点一下按钮，一秒根据数据更新地图颜色；

广东省：

山东省：

视频演示效果：

在EXCEL中复制粘贴这段VBA代码：

Sub 地图填充颜色()Dim sht As Worksheet, i%Dim shp As Shape, shpname As String, mydata AsDoubleDim l1 AsDouble, l2 AsDouble, l3 AsDouble, l4 AsDouble, l5 AsDoubleSet sht = ActiveSheetmax_row = sht.Range("a10086").End(xlUp).RowWith sht    l1 = .Range("f2")    l2 = .Range("f3")    l3 = .Range("f4")    l4 = .Range("f5")    l5 = .Range("f6")For i =2To max_row      shpname = .Range("A" & i)      mydata = .Range("b" & i)SelectCaseTrueCase mydata <= l1            mycolor = .Range("g2").Interior.ColorOn Error Resume NextSet shp = sht.Shapes(shpname)On Error GoTo 0            If Not shp Is Nothing Then                shp.Fill.ForeColor.RGB = mycolor                shp.Fill.Visible = msoTrue             End If        Case mydata > l1 And mydata <= l2            mycolor = .Range("g3").Interior.Color            On Error Resume Next            Set shp = sht.Shapes(shpname)            On Error GoTo 0            If Not shp Is Nothing Then                shp.Fill.ForeColor.RGB = mycolor                shp.Fill.Visible = msoTrue End IfCase mydata > l2 And mydata <= l3            mycolor = .Range("g4").Interior.ColorOn Error Resume NextSet shp = sht.Shapes(shpname)On Error GoTo 0            If Not shp Is Nothing Then                shp.Fill.ForeColor.RGB = mycolor                shp.Fill.Visible = msoTrue             End If        Case mydata > l3 And mydata <= l4            mycolor = .Range("g5").Interior.Color            On Error Resume Next            Set shp = sht.Shapes(shpname)            On Error GoTo 0            If Not shp Is Nothing Then                shp.Fill.ForeColor.RGB = mycolor                shp.Fill.Visible = msoTrue End IfCase mydata > l4            mycolor = .Range("g6").Interior.ColorOn Error Resume NextSet shp = sht.Shapes(shpname)On Error GoTo 0            If Not shp Is Nothing Then                shp.Fill.ForeColor.RGB = mycolor                shp.Fill.Visible = msoTrue             End If      End Select  Next iEnd WithEnd Sub