ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 2213|回复: 32

[求助] excel自动生成图表并导出jpg

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-15 19:45 | 显示全部楼层 |阅读模式
附件是手机销售数据表,表中的sheet1是卖场一天的手机销售情况,卖场按照手机品牌的不同分为“苹果”“华为”“小米”等13个部门,现在要将手机销售数据按照部门的不同,筛选出每部门top20,分别制作销售top20图(簇状条形图),然后发送给上级领导。
我之前对excel没有深入了解过,只是简单做个表格会几个简单的函数,所以前述任务处理起来费时费力,一开始是挨个手动出,太费时间。
后来又尝试power quest,先把销售数据表按部门和销售额排序,再用vba分成13个表,然后再删除每个表top20以外的条目,最后用事先做好的模板统一刷新,可以得到想要的图,虽然比之前时间有所短,还是感觉费事,除了事先要先将sheet1总表排序和分解为13个表的必要准备工作之外,主要是手动删除13个部门表的top20以外记录,再手动拷贝每部门的销售图另存为jpg,保存jpg时还要按照命名规则保存,以便整理成pdf时部门排序和公司系统内的部门顺序一致。
再后来,看到有人说用vba,可以实现多张表的情况下,一键出图,而且图片的都是按照既定规则命名的,查了查可能用的是宏,自己试了试,在录制宏后,再执行时,总出错,看代码里的黄色高亮提示,错误可能是改变图表属性(大小、颜色、图例等)或是其他值、以及保存时导致的,上网查也没有头绪,而且好像用宏方式自动生成的图都是excel默认大小,我在录制宏的时候明明是调整过的…
说了这么多,就是想请教大家,怎样可以实现这种一键出图的效果,或者类似的效果,附件是销售情况表,excel大神烦请给出方案。附件说明以及要求如下:
①sheet1是销售数据表,我事先已经把“销售数据表”按部门拆分为13个表,需要实现的是,如何自动拆分sheet1表,筛选出每部门的top20,并且删除掉top20以外的条目(如果不删除也能实现top20图表,那就不用删)
②前几个手机部门的销售top20图已给出了,要求出的簇状条形图大小、颜色和已出的保持一致,并且带图例
③excel表里的条形图的图表标题都统一命名为“XX手机销售top20机型”
④在将top20条形图自动保存(或导出)为jpg格式的图片时,命名规则为“部门代码_XX手机top20“,如“010101_苹果手机top20”
⑤自动保存为jpg格式的图要和excel里的原簇状条形图大小一致

谢谢有耐心的朋友看到这里,再罗嗦两句,我想要的是具体的实现方法,不是给指个方向,不是我不想花时间研究,是每天弄这几个店的图表(除了这个销售数据表,还有其他表也要出具体图表)得耗我几个小时,晚上根本没时间,如果能快速实现图表处理,有时间好好学习下excel,那真是再好不过了。我也为能完全按照要求给出方案的英雄准备了红包,两张红装毛主席吧,微表谢意,注意啊,是微表,觉得太少受到侮辱的请无视,谢谢。

手机销售数据.rar

81.93 KB, 下载次数: 66

TA的精华主题

TA的得分主题

发表于 2020-1-15 21:07 | 显示全部楼层
看你的解说确实需要耐心,写的够多的,还没看附件,我觉得设计好表格以后,图表是随着数据更新而更新的,所以一次设计可以一直使用

TA的精华主题

TA的得分主题

发表于 2020-1-15 21:17 | 显示全部楼层
本帖最后由 micch 于 2020-1-15 21:21 编辑

1.jpg

非常标准的透视表+透视图例子,简单说明一下,根据源直接生成透视表+透视图,透视表筛选选择手机品牌,行用型号,值就是净销售额

然后透视表,可以根据值排序,并且根据值筛选前多少项,这里选择20项。然后透视图自己设计想要的格式。

数据更新的时候,就可以刷新一下。

如果你还是喜欢一个品牌一张表配一张图,可以将生成的表格复制13份也就是了。

附件需要再发,自己尝试一下能做出来就省得我压缩再发了,想录屏可惜肯定超2M大小了


最后补充一句,如果你是要存为图片发送老板看,这一步可以手工完成,拍照13次,当然更可以代码完成。前提是老板不喜欢Excel文件,我觉得Excel文件能互动比图片更好,发Excel文件其实挺好的

评分

参与人数 2鲜花 +4 收起 理由
recloud + 2 值得肯定
zpy2 + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

发表于 2020-1-15 23:11 | 显示全部楼层
本帖最后由 micch 于 2020-1-16 10:34 编辑

给你个代码解决方式的。

Sub savechart()
    arr = Sheet1.UsedRange
    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(arr)
        If arr(i, 3) <> "" Then
            x = arr(i, 3) & " " & arr(i, 4)
            If Not d.exists(x) Then Set d(x) = CreateObject("scripting.dictionary")
            d(x)(arr(i, 6)) = d(x)(arr(i, 6)) + arr(i, 7)
        End If
    Next
    With Sheets("苹果")
        Set cht = .ChartObjects(1)
        For Each x In d.keys
            .[f2:g21].ClearContents
            .[f2].Resize(d(x).Count, 2) = Application.Transpose(Array(d(x).keys, d(x).items))
            .[f2].Resize(d(x).Count, 2).Sort .[g2], 2
            cht.Chart.SetSourceData Source:=.[f1].Resize(IIf(d(x).Count > 20, 21, d(x).Count + 1), 2)
            cht.Chart.ChartTitle.Text = Split(x)(1) & "手机销售TOP20机型"
            myname$ = ThisWorkbook.Path & "\" & Split(x)(0) & "_" & Split(x)(1) & "TOP20.jpeg"
            cht.Chart.Export Filename:=myname, FilterName:="jpeg"
        Next
    End With
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-16 16:27 | 显示全部楼层
首先,非常感谢,我不懂代码,所以还得问详细些
①您给的这段代码是否需要提前把sheet1表拆分为13个表?我直接在vba运行环境下执行,报错,“运行时错误9:下表越界”
②如果需要先把表拆分为13个表,那么拆解的代码和您给的这段代码应该怎么组合,才能实现自动导出条形图片的效果?
③With Sheets("苹果") ……end with,每个手机都需要这么一段代码吗?程序没法执行,我看不出执行效果
附件压缩包包括两部分,txt文档是我之前从网上找的拆分表的代码,压缩包是我之前看的一个网友的例子,我要的是这种效果,您看一下是否能够实现

表拆分代码和自动生成图表并保存的例子.rar

119.61 KB, 下载次数: 21

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-16 16:34 | 显示全部楼层
micch 发表于 2020-1-15 21:17
非常标准的透视表+透视图例子,简单说明一下,根据源直接生成透视表+透视图,透视表筛选选择手机品牌, ...

领导不看excel表的,如果直接给他excel可以的话,就不用我又是导出图,又是整理成pdf文档了,拍照的方式不可取,你说的这种透视图表的这种方法,效率可能和我目前用power quest差不多,直接生成图标并要求大小导出为jpg的这种方式效率更高,我还是倾向于vba代码方式,无奈没基础,哎

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-16 16:36 | 显示全部楼层
micch 发表于 2020-1-15 23:11
给你个代码解决方式的。

Sub savechart()

代码这种方式我试了一下,有些疑问,见5楼

TA的精华主题

TA的得分主题

发表于 2020-1-16 16:41 | 显示全部楼层
本帖最后由 micch 于 2020-1-16 16:48 编辑

因为你要的是图片,所以就不需要13个表了,13个图都在苹果表里循环了,循环一次就把对应手机的数据输出到FG列,然后把条形图输出一张图片,如果你还是要13个工作表并且附带13个条形图,然后再输出13个图片,那就太麻烦了,晚上的火车怕是没时间给你改了,直接给你个附件自己先琢磨的改下吧
没个手机一份数据,存在字典里,for循环的时候,循环一次生成一个表一个图,如果你希望是13个表,可以在循环的过程中加入语句,可以直接copy苹果表,然后数据覆盖一下


手机销售数据.zip (183.27 KB, 下载次数: 32)

TA的精华主题

TA的得分主题

发表于 2020-1-17 14:19 | 显示全部楼层
修改一下,生成13个表,输出13个图,条形图直接用苹果表做模板

  1. Sub savechart()
  2.     arr = Sheet1.UsedRange
  3.     Set d = CreateObject("scripting.dictionary")
  4.     For i% = 2 To UBound(arr)
  5.         If arr(i, 3) <> "" Then d(arr(i, 3) & "" & arr(i, 4)) = d(arr(i, 3) & "" & arr(i, 4)) & " " & i
  6.     Next i
  7.     Application.ScreenUpdating = False
  8.     Application.DisplayAlerts = False
  9.     For Each sht In Sheets
  10.         If sht.Name <> "Sheet1" And sht.Name <> "苹果" Then sht.Delete
  11.     Next
  12.     Set sht = Sheets("苹果")
  13.     For Each x In d.keys
  14.         ar = Split(d(x))
  15.         ReDim brr(1 To UBound(ar), 1 To 9)
  16.         With sht
  17.             .[a2:k222].ClearContents
  18.             For i = 1 To UBound(ar)
  19.             For k% = 1 To 9
  20.                 brr(i, k) = arr(ar(i), k)
  21.             Next k, i
  22.             .[a2].Resize(i - 1, 9) = brr
  23.             .[a2].Resize(i - 1, 9).Sort .[g2], 2
  24.             .[a2].Offset(IIf(i > 20, 20, i)).Resize(99, 9).ClearContents
  25.             Set cht = .ChartObjects(1)
  26.             cht.Chart.SetSourceData Source:=.[f1].Resize(IIf(i > 20, 21, i), 2)
  27.             cht.Chart.ChartTitle.Text = .[d2] & "手机销售TOP20机型"
  28.             myname$ = ThisWorkbook.Path & "" & .[c2] & "_" & .[d2] & "TOP20.jpeg"
  29.             cht.Chart.Export Filename:=myname, FilterName:="jpeg"
  30.             If .[d2].Value = "苹果" Then
  31.                 crr = .[a2:k21]
  32.             Else
  33.                 sht.Copy after:=Sheets(Sheets.Count)
  34.                 Sheets(Sheets.Count).Name = sht.[d2]
  35.             End If
  36.         End With
  37.     Next
  38.     sht.[a2:k21] = crr
  39.     Application.ScreenUpdating = True
  40.     Application.DisplayAlerts = True
  41. End Sub
复制代码

评分

参与人数 1鲜花 +1 收起 理由
zhuzhenya0921 + 1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-17 23:44 | 显示全部楼层
micch 发表于 2020-1-17 14:19
修改一下,生成13个表,输出13个图,条形图直接用苹果表做模板

非常感谢非常感谢
这个我明天试试,今天太晚了,另外,分解成13个表这一步不是必要的,我最终要的是图
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-10-1 10:06 , Processed in 0.087597 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2021 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表