手把手教你用EXCEL手搓一个春晚收视率数据地图?地图根据数据自动变化!
- 2026-11-13 09:52:48
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个城市，直辖市细分到市里的行政区；
更新数据和颜色即可变成自己的数据地图，点一下按钮，一秒根据数据更新地图颜色；
视频演示效果：
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 shtl1 = .Range("f2")l2 = .Range("f3")l3 = .Range("f4")l4 = .Range("f5")l5 = .Range("f6")For i =2To max_rowshpname = .Range("A" & i)mydata = .Range("b" & i)SelectCaseTrueCase mydata <= l1mycolor = .Range("g2").Interior.ColorOn Error Resume NextSet shp = sht.Shapes(shpname)On Error GoTo 0If Not shp Is Nothing Thenshp.Fill.ForeColor.RGB = mycolorshp.Fill.Visible = msoTrueEnd IfCase mydata > l1 And mydata <= l2mycolor = .Range("g3").Interior.ColorOn Error Resume NextSet shp = sht.Shapes(shpname)On Error GoTo 0If Not shp Is Nothing Thenshp.Fill.ForeColor.RGB = mycolorshp.Fill.Visible = msoTrueEnd IfCase mydata > l2 And mydata <= l3mycolor = .Range("g4").Interior.ColorOn Error Resume NextSet shp = sht.Shapes(shpname)On Error GoTo 0If Not shp Is Nothing Thenshp.Fill.ForeColor.RGB = mycolorshp.Fill.Visible = msoTrueEnd IfCase mydata > l3 And mydata <= l4mycolor = .Range("g5").Interior.ColorOn Error Resume NextSet shp = sht.Shapes(shpname)On Error GoTo 0If Not shp Is Nothing Thenshp.Fill.ForeColor.RGB = mycolorshp.Fill.Visible = msoTrueEnd IfCase mydata > l4mycolor = .Range("g6").Interior.ColorOn Error Resume NextSet shp = sht.Shapes(shpname)On Error GoTo 0If Not shp Is Nothing Thenshp.Fill.ForeColor.RGB = mycolorshp.Fill.Visible = msoTrueEnd IfEnd SelectNext iEnd WithEnd Sub
关注我，点底部头像到主页，点右上角“…”，设为星标，才不错容易过精彩文章哦。
往期干货文章学习推荐：
WPS打开宏文件提示“无权限”及宏“被禁止”怎么办？【插件限时领取】
分享高效办公技巧及免费自动化模版，避免以后需要找不到，请您持续关注哦
