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

wangg913

题目为网友求助帖。

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

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

2014-7-4 00:47 上传

点击文件名下载附件

delete_007

20140704-多系列散点图(delete_007).rar (35.97 KB, 下载次数: 71)

2014-7-4 15:22 上传

点击文件名下载附件

在原过程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.用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

悠悠的炊烟

主要步骤:
1. 随便选取前几行数据，例如b2:Lc10，做只带数据标记的散点图；美化图表；
2. VBE里写代码
1)  调用生成数据源的程序
2)  删除图表所有数据系列
3)  字典生成不重复批号
4)  数组1（不重复批号）、数组2（不含第1行的数据源） +  循环 》找到批号相同的装到数组(arr)中
5)  根据4）中的数组(arr), 生成新图表系列，取数组(arr)的第1列为X值，数组(arr)的第2列为Y值
---------------------------------------------------------------------------------------------------------------------------------
做题感想：
做题过程中发现用数组+循环生成不重复批次好麻烦，绕晕了还没绕出来，忽然想起谁曾说过用字典提取不重复值很轻松。懒，一直没学字典，终于在这题的诱惑下打开了兰版的视频，现学了一下。
事实证明临时抱佛脚是可以的！车道山前必有路，我坚信。

w83365040371

用的sql生成二维表格
20140703-多系列散点图.rar (38.06 KB, 下载次数: 83)

2014-7-14 20:57 上传

点击文件名下载附件

wangg913

近期要出差，先将我的答案上传。也是使用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. 
   
4. SeriesExtract dXY
   
5. 
   
6. If Sheet1.ChartObjects.Count Then Sheet1.ChartObjects.Delete
   
7. Sheet1.Shapes.AddChart.Select
   
8. ActiveChart.ChartType = xlXYScatter
   
9. 
   
10. Charting ActiveChart, dXY
    
11. 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. 
   
6. Set mDic = CreateObject("Scripting.Dictionary")
   
7. dArr = Range("a1").CurrentRegion
   
8. For i = 2 To UBound(dArr)
   
9.     mDic(dArr(i, 1)) = mDic(dArr(i, 1)) + 1
   
10. Next
    
11. 
    
12. ReDim dXY(mDic.Count - 1)
    
13. For j = 0 To mDic.Count - 1
    
14.     dXY(j).Legend = mDic.Keys()(j)
    
15.     k = 0
    
16.     ReDim dXY(j).xValues(mDic.items()(j) - 1)
    
17.     ReDim dXY(j).yValues(mDic.items()(j) - 1)
    
18.     For i = 2 To UBound(dArr)
    
19.     If dArr(i, 1) = mDic.Keys()(j) Then
    
20.         dXY(j).xValues(k) = dArr(i, 2)
    
21.         dXY(j).yValues(k) = dArr(i, 3)
    
22.         k = k + 1
    
23.     End If
    
24.     Next i
    
25. Next j
    
26. End Sub

复制代码

4、过程 Charting 使用 dXY 制图。

1. Sub Charting(cScatter As Chart, dXY() As dataXYSc)
   
2. Dim i As Integer
   
3. 
   
4. For i = 0 To UBound(dXY)
   
5.     cScatter.SeriesCollection.NewSeries
   
6.     With cScatter.SeriesCollection(i + 1)
   
7.         .Name = dXY(i).Legend
   
8.         .xValues = dXY(i).xValues
   
9.         .Values = dXY(i).yValues
   
10.         .MarkerStyle = xlMarkerStyleCircle  'Circle Marker
    
11.         .MarkerSize = 13
    
12.     End With
    
13. Next
    
14. 
    
15. With cScatter
    
16.     .Axes(xlCategory).MaximumScale = 1
    
17.     .Axes(xlValue).MaximumScale = 1
    
18.     .SetElement (msoElementPrimaryCategoryGridLinesMajor)
    
19.     .Axes(xlValue).MajorUnit = 0.2
    
20. End With
    
21. End Sub

复制代码

悠悠的炊烟

头版出差在外不方便批阅委托我看看，我主要是看达未达到题目要求的效果，初判结果如下：


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

wangg913

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

2014-7-20 15:10 上传

点击文件名下载附件

tombomok

车仁静 发表于 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里应用的教程可以在哪里找到？网上找了很多都没有，想自学都困难。
望不吝赐教，谢谢