[已解决]求：这种地图图表代码怎么改？

苏子龙 · 发表于 2017-8-18 23:04

fxgg72 发表于 2017-8-18 11:12
特别的难过

改颜色的录制个宏看看什么代码？自己动手试试啊，现在基本上没人用2003版了

fxgg72 · 发表于 2017-8-20 15:51

苏子龙发表于 2017-8-18 23:04
改颜色的录制个宏看看什么代码？自己动手试试啊，现在基本上没人用2003版了

可我们公司及客户还有供应商90%还是在用03版，我也一样。习惯了。老师能帮忙把1楼的代码改改吗？
谢谢！

fxgg72 · 发表于 2017-8-20 16:08

这儿有肥猫发表于 2017-8-18 09:24
关键是我手头所有的电脑装的最低版本都是2007的

想给您个最佳呢！
可我的问题还没解决啊？
老师您想想办法能帮我做下03的么？
谢谢！

苏子龙 · 发表于 2017-8-20 17:17

fxgg72 发表于 2017-8-20 16:08
想给您个最佳呢！
可我的问题还没解决啊？
老师您想想办法能帮我做下03的么？

03测试代码能用，就是地图要先取消组合

fxgg72 · 发表于 2017-8-21 10:04

苏子龙发表于 2017-8-20 17:17
03测试代码能用，就是地图要先取消组合

地图图表增添了2列，有点问题？.rar (35.61 KB, 下载次数: 6)

苏子龙 · 发表于 2017-8-21 10:37

Sub 合同总额()
Dim arr, i, brr, j
On Error Resume Next
Call 取消组合 '加取消组合和组合，应急满足运行宏要求
arr = [o3:s34] '数据源，O是拼音，后面是数据源
brr = [l3:m8] '颜色区域
For i = 1 To UBound(brr)
brr(i, 1) = Range("l" & i + 2).Interior.Color '把颜色值给brr(i,1)
Next
For j = 1 To UBound(arr) '通过改变arr(j,N)中的n换数据源，range("m3:m8")换数据范围，自己试试
ActiveSheet.Shapes(arr(j, 1)).Fill.ForeColor.RGB = brr(Application.Match(Application.Lookup(arr(j, 4), Range("m3:m8")), [m3:m8], 0), 1)
Next
Call 组合
End Sub
Sub 组合() '通过录制宏写代码
ActiveSheet.Shapes.Range(Array("hainan", _
"shanghai", "henan", "taiwan", "guangdong", "guangxi", "fujian", "jiangxi", _
"hunan", "guizhou", "zhejiang", "anhui", "jiangsu", "hubei", "shanxi3", _
"shanxi1", "shandong", "tianjin", "beijing", "ninxia", "xizang", "yunnan", _
"qinghai", "sichuan", "gansu", "hebei", "neimenggu", "liaoning", "jilin", _
"heilongjiang", "xinjiang", "chongqing")).Select
ActiveWindow.SmallScroll Down:=3
Selection.ShapeRange.Group.Select
Selection.Name = "zuhe" '给他取名
End Sub
Sub 取消组合()
ActiveSheet.Shapes("zuhe").Select
Selection.ShapeRange.Ungroup.Select
End Sub

复制代码

fxgg72 · 发表于 2017-8-21 11:33

苏子龙发表于 2017-8-21 10:37

地图图表问题？.rar (37.52 KB, 下载次数: 5)

苏子龙 · 发表于 2017-8-21 11:45

Sub 按客户数新()
Dim arr, i, brr, j
On Error Resume Next
Call 取消合并 '加取消组合和组合，应急满足运行宏要求
arr = [o3:s36] '数据源，O是拼音，后面是数据源
brr = [l15:m20] '颜色区域
For i = 1 To UBound(brr)
brr(i, 1) = Range("l" & i + 14).Interior.Color '把颜色值给brr(i,1)，对应颜色单元格i+14,就是从I15开始的，颜色数据源
Next
For j = 1 To UBound(arr) '通过改变arr(j,N)中的n换数据源这里的数据源n=2
ActiveSheet.Shapes(arr(j, 1)).Fill.ForeColor.RGB = brr(Application.Match(Application.Lookup(arr(j, 2), Range("m15:m20")), [m15:m20], 0), 1)
Next
Call 合并
End Sub

授人与鱼不如授人予渔，自己体会吧，先想想代码做什么用的！

fxgg72 · 发表于 2017-8-21 21:16

苏子龙发表于 2017-8-21 11:45
Sub 按客户数新()
Dim arr, i, brr, j
On Error Resume Next

非常感谢！
胡乱猜测这改了下，还蒙出来了。实际我是菜鸟。
感谢您的不厌其烦的解答！

		自动登录	找回密码
密码			注册

[已解决]求：这种地图图表代码怎么改？

评分

评分

评分