ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 6581|回复: 8

[讨论] [应用案例 01]多系列散点图

[复制链接]

TA的精华主题

TA的得分主题

发表于 2014-7-4 00:46 | 显示全部楼层 |阅读模式
本帖最后由 wangg913 于 2014-7-17 15:46 编辑

题目为网友求助帖。

题目说明
A\B\C三列数据为入库产品批次号、进厂值和原厂值。
由采购部提供的数据中,批次数量不是固定的,可能为2个批次,亦可能更多。

图表制作要求
使用该数据制作“仅带数据标记的散点图”,用于以后的财务分析;
X轴为“进厂值”,Y轴为“原厂值”;
凡相同批次号的产品,认定为一个数据系列;
不同数据系列使用不同颜色进行区分;
图表要实现随数据变动而改变,点击“重新生成数据”按钮,生成新的数据后图表能随之改变。
题目自 2014-7-4 至 2014-7-17 ,2014-7-18开贴。
不限定VBA、函数公式、定义名称等形式,不过要尽量使用简洁的办法。
能实现动态效果的,奖励技术分 1分。否则只奖励财富。
20140703-多系列散点图.rar (33.22 KB, 下载次数: 289)




评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-7-4 15:19 | 显示全部楼层
本帖最后由 delete_007 于 2014-7-4 15:22 编辑

20140704-多系列散点图(delete_007).rar (35.97 KB, 下载次数: 71)
在原过程Data_Generation  End Sub 前添加一句代码Call InsertChart即可完成动态作图。
插入图表代码如下:
  1. Public Sub InsertChart()
  2.     Dim arr, i%, j%, d, PiHao, X, Y
  3.     On Error Resume Next
  4.     Application.ScreenUpdating = False
  5.     Set d = CreateObject("scripting.dictionary")
  6.    
  7.     arr = Sheet1.Range("A1").CurrentRegion
  8.     For i = 2 To UBound(arr)
  9.         If Not d.exists(arr(i, 1)) Then Set d(arr(i, 1)) = CreateObject("scripting.dictionary")
  10.         d(arr(i, 1))(arr(i, 2)) = arr(i, 3)
  11.     Next
  12.     Sheet1.ChartObjects.Delete
  13.     Charts.Add
  14.     ActiveChart.SeriesCollection(1).Delete
  15.     ActiveChart.Location where:=xlLocationAsObject, Name:="Sheet1"
  16.     PiHao = d.keys
  17.     For i = 0 To UBound(PiHao)
  18.         X = d(PiHao(i)).keys
  19.         Y = d(PiHao(i)).items
  20.         ActiveChart.SeriesCollection.NewSeries
  21.         With ActiveChart.SeriesCollection(i + 1)
  22.             .Name = PiHao(i)
  23.             .XValues = X
  24.             .Values = Y
  25.         End With
  26.     Next
  27.     With ActiveChart
  28.         .ChartType = xlXYScatter
  29.         .Axes(xlValue).MaximumScale = 1
  30.         .Axes(xlValue).MajorUnit = 0.2
  31.         .Axes(xlCategory).MaximumScale = 1
  32.         .Axes(xlCategory).MajorUnit = 0.2
  33.         .Axes(xlCategory).HasMajorGridlines = True
  34.         .Axes(xlValue).MajorTickMark = xlNone
  35.         .Axes(xlCategory).MajorTickMark = xlNone
  36.     End With
  37.     Set d = Nothing
  38.     Application.ScreenUpdating = True
  39. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-7-4 17:18 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 车仁静 于 2014-7-7 10:34 编辑

1.用SQL生成在单元格Q1生成[表1]
  1. TRANSFORM AVG(原厂值)
  2. SELECT 进厂值
  3. FROM [Sheet1$A:C]
  4. WHERE 批号<>NULL  
  5. GROUP BY 批号,进厂值,原厂值  
  6. PIVOT 批号
复制代码

用聚合函数AVG,在“相同Batch,相同进厂值,原厂值同时”,确保图表Y值正确;
[GROUP BY 批号,进厂值,原厂值],在“相同Batch,相同进厂值,原厂值不同时”,确保图表Y值正确。

用此方法,数据量不大时不影响内存;同一家公司,把文件放在同一共用文件目录下,无所谓安全性。
数据海量时,可用ADO完成,释放内存,但要考虑作图人和看图人的EXCEL版本。

2.插入“仅带数据标记的散点图”,图表数据区域[表1]

3.在题目的宏代码最后加一句
   [Q1].ListObject.QueryTable.Refresh BackgroundQuery:=False


多系列散点图-车仁静.rar

38.98 KB, 下载次数: 52

多系列散点图ADO-车仁静.rar

42.48 KB, 下载次数: 41

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-7-7 16:23 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
chart.gif
主要步骤:
1. 随便选取前几行数据,例如b2:Lc10,做只带数据标记的散点图;美化图表;
2. VBE里写代码
1)  调用生成数据源的程序
2)  删除图表所有数据系列
3)  字典生成不重复批号
4)  数组1(不重复批号)、数组2(不含第1行的数据源) +  循环 》找到批号相同的装到数组(arr)中
5)  根据4)中的数组(arr), 生成新图表系列,取数组(arr)的第1列为X值,数组(arr)的第2列为Y值
---------------------------------------------------------------------------------------------------------------------------------
做题感想:
做题过程中发现用数组+循环生成不重复批次好麻烦,绕晕了还没绕出来,忽然想起谁曾说过用字典提取不重复值很轻松。懒,一直没学字典,终于在这题的诱惑下打开了兰版的视频,现学了一下。
事实证明临时抱佛脚是可以的!车道山前必有路,我坚信。

01 多系列散点图.zip

38.93 KB, 下载次数: 44

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2014-7-14 20:58 | 显示全部楼层
用的sql生成二维表格
20140703-多系列散点图.rar (38.06 KB, 下载次数: 83)

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-7-14 21:08 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 wangg913 于 2014-7-15 18:18 编辑

近期要出差,先将我的答案上传。也是使用VBA代码实现的。
1、首先定义一个数据结构,用于存储 多个数据系列的 X坐标和Y坐标,以及数据系列的图例名称。
  1. Private Type dataXYSc
  2.     xValues() As Single
  3.     yValues() As Single
  4.     Legend As String
  5. End Type
复制代码
2、在 Data_Generation 过程结束之前的添加代码:
  1. myScatter
复制代码
myScatter 过程的代码如下:
  1. Sub myScatter()
  2. Dim dXY() As dataXYSc

  3. SeriesExtract dXY

  4. If Sheet1.ChartObjects.Count Then Sheet1.ChartObjects.Delete
  5. Sheet1.Shapes.AddChart.Select
  6. ActiveChart.ChartType = xlXYScatter

  7. Charting ActiveChart, dXY
  8. End Sub
复制代码
3、过程 SeriesExtract 负责提取数据,将提取的各数据系列值赋值给数据结构 dXY 。
  1. Sub SeriesExtract(ByRef dXY() As dataXYSc)
  2. Dim mDic As Object
  3. Dim dArr()
  4. Dim i%, j%, k%

  5. Set mDic = CreateObject("Scripting.Dictionary")
  6. dArr = Range("a1").CurrentRegion
  7. For i = 2 To UBound(dArr)
  8.     mDic(dArr(i, 1)) = mDic(dArr(i, 1)) + 1
  9. Next

  10. ReDim dXY(mDic.Count - 1)
  11. For j = 0 To mDic.Count - 1
  12.     dXY(j).Legend = mDic.Keys()(j)
  13.     k = 0
  14.     ReDim dXY(j).xValues(mDic.items()(j) - 1)
  15.     ReDim dXY(j).yValues(mDic.items()(j) - 1)
  16.     For i = 2 To UBound(dArr)
  17.     If dArr(i, 1) = mDic.Keys()(j) Then
  18.         dXY(j).xValues(k) = dArr(i, 2)
  19.         dXY(j).yValues(k) = dArr(i, 3)
  20.         k = k + 1
  21.     End If
  22.     Next i
  23. Next j
  24. End Sub
复制代码
4、过程 Charting 使用 dXY 制图。
  1. Sub Charting(cScatter As Chart, dXY() As dataXYSc)
  2. Dim i As Integer

  3. For i = 0 To UBound(dXY)
  4.     cScatter.SeriesCollection.NewSeries
  5.     With cScatter.SeriesCollection(i + 1)
  6.         .Name = dXY(i).Legend
  7.         .xValues = dXY(i).xValues
  8.         .Values = dXY(i).yValues
  9.         .MarkerStyle = xlMarkerStyleCircle  'Circle Marker
  10.         .MarkerSize = 13
  11.     End With
  12. Next

  13. With cScatter
  14.     .Axes(xlCategory).MaximumScale = 1
  15.     .Axes(xlValue).MaximumScale = 1
  16.     .SetElement (msoElementPrimaryCategoryGridLinesMajor)
  17.     .Axes(xlValue).MajorUnit = 0.2
  18. End With
  19. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2014-7-17 20:11 | 显示全部楼层
头版出差在外不方便批阅委托我看看,我主要是看达未达到题目要求的效果,初判结果如下:
2014717-20521.jpg

分数找头版要,随便说一句:
大家的技术都很高,八仙过海各显神通,但对图表最基本的美化还是欠缺或轻视的,作为图表版块的答题有点不应该。
下次整个纯图表的。

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2014-7-17 21:05 | 显示全部楼层
本帖最后由 wangg913 于 2014-7-20 15:10 编辑

题目截止,因出差异地,现邀请烟班测评。
感谢烟班汇总参评,如没有什么异议,就照其所说。
总结预计要等20号以后了。
================================
我的附件:
20140714-多系列散点图.rar (41.58 KB, 下载次数: 104)

TA的精华主题

TA的得分主题

发表于 2020-5-2 21:07 | 显示全部楼层
车仁静 发表于 2014-7-4 17:18
1.用SQL生成在单元格Q1生成[表1]

用聚合函数AVG,在“相同Batch,相同进厂值,原厂值同时”,确保图表Y ...

你好,想问下,为什么你第一个文件运行[Q1].ListObject.QueryTable.Refresh BackgroundQuery:=False这一句时会自动去找第二个文件中的sub sourcedata 去运行?然后如果找不到的话就运行不了。
设了什么“机关”啊?完全想不明白,明明就是两个excel 文件啊。
另外想知道 关于listobject.querytable, ocbcconnection 这方面在vba里应用的教程可以在哪里找到?网上找了很多都没有,想自学都困难。
望不吝赐教,谢谢
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-3-29 10:38 , Processed in 0.058466 second(s), 18 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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