[第102期]堆积柱形和柱形混搭图[已总结]

jsxjd

VBA一键制图：

delete_007

答题截止日期已到，请楼上各位不要再编辑帖子，以免影响评分。

悠悠的炊烟

总结

一、        我的构思
1.         无论采用VBA法还是函数法，首先都需要构建一个做图辅助数据区，这是做图的关键；
1.1        堆积柱形图，柱子间距为0。列方向做堆积柱形图，除“季度”外一列为一个图表数据系列。此外，“损益”的数据标签需要用一个数据系列来占位；
1.2        每一个季度的空距用一个空行占位，每一个季度分别由水果柱子、蔬菜柱子、损益柱子、空距组成，需要四行；
1.2.1        第1个柱子为“水果”，应保持本季度的所有水果品种虽在不同的列但却在同一个行上，且在本四行中的第1行。这样才能实现堆积，且为第1个柱子；
1.2.2        第2个柱子为“蔬菜”，应保持本季度的所有蔬菜品种虽在不同的列但却在同一个行上，且在本四行中的第2行。这样才能实现堆积，且为第2个柱子；
1.2.3        “损益”的数据标签需要一个数据系列来占位，它左临损益，基本就是损益的复制，只是符号正好相反。它的填充色：无；数字标签：红色；
“损益”及“损益”的数据标签为第3个柱子，在本四行中的第3行，为第3个柱子；
1.2.4        分类数据（季度）在本四行中的第2行，尽量居中；

小结：


2.         根据做图辅助数据区做图
VBA法：
此题用VBA法应该更合适，特别在构建做图数据源方面，其它做图的很多语句可以通过录制宏得到。边学边做，也是很有乐趣的。
函数法：
本以为用函数构建做图数据源对函数高手来说不难，只要他们了解到底要构建什么样的数据源才能得到题目要求的图形，后来发现这题用函数做还真有点纠结。其它的图表修饰就是最基本的东西。

二、        我的做法
1.        VBA法：详见文件“堆积柱形图和柱形图混搭”的工作表“题目”；
2.        函数法：另见附件
函数法在满足“损益”数据标签要求的情况下，图例会存在一些小瑕疵，某些没有数据的图例依然会显示。至少目前我还没找到解决方案，题目未对图例有要求，就忽略这个瑕疵吧。

三、        其它
本题在掌握图表基础知识的基础上，通过VBA或函数构建做图数据源，从而达到题目要求的效果，算是跨领域协作吧。
此题本是V白的我学习V和图表结合的一个忽发奇想，苦于鲜见V和图表结合的案例，斗胆抛砖引玉，希望借此偷得大V们的一鳞半爪。

总结一下大家的做法：

sunya_0529

谢谢楼主的点评，题目中没有要求数据源不能排序。不过我也学到了堆积图中同一柱子堆积的数据放在同一行上就行，不一定要逐列地挨在一起，涨姿势了，再致谢意。

sunya_0529

sunya_0529 发表于 2014-3-26 21:24
谢谢楼主的点评，题目中没有要求数据源不能排序。不过我也学到了堆积图中同一柱子堆积的数据放在同一行上就 ...

重新整理了一下代码，加上了新学的一些知识，留个纪念。

1. 
   
2. Private Sub CommandButton2_Click() '一键制图
   
3. '生成图表
   
4. Dim w As Shape, x As Chart, arr(15), k As Range, i%, j%, h%
   
5. For Each w In ActiveSheet.Shapes '删除已有图表
   
6.   If w.Type = msoChart Then w.Delete
   
7. Next
   
8. Set x = ActiveSheet.Shapes.AddChart.Chart '新建图表
   
9. With x
   
10.   .ChartType = xlColumnStacked '设置图表类型为堆积柱形图
    
11.   .SetSourceData Source:=[A4] '设置图表数据源
    
12. 
    
13.   '设置水平（分类）轴标签
    
14.   .SeriesCollection(1).XValues = Array("", "Q1", "", "", "", "Q2", "", "", "", "Q3", "", "", "", "Q4", "", "")
    
15.   .Axes(xlCategory).MajorTickMark = xlNone '无横坐标刻度线
    
16.   .Axes(xlCategory).TickLabelPosition = xlLow '横坐标标签位置置底
    
17. 
    
18.   For Each k In [B4:K4] '循环添加数据系列
    
19.     If Len(k.Value) > 0 Then
    
20.       i = i + 1
    
21.       If i > 1 Then .SeriesCollection.NewSeries
    
22.       .SeriesCollection(i).Name = k.Value '添加数据系列名称
    
23.       Erase arr '重新初始化数组
    
24.       Select Case Application.IfError(Application.VLookup(k.Value, [A13:B21], 2, 0), "")
    
25.         Case "水果"
    
26.           h = 0
    
27.         Case "蔬菜"
    
28.           h = 1
    
29.         Case Else
    
30.           h = 2
    
31.       End Select
    
32.       arr(h) = k.Offset(1, 0)
    
33.       arr(h + 4) = k.Offset(2, 0)
    
34.       arr(h + 8) = k.Offset(3, 0)
    
35.       arr(h + 12) = k.Offset(4, 0)
    
36.       .SeriesCollection(i).Values = arr '添加数据系列值
    
37.     End If
    
38.   Next
    
39.   For j = 0 To UBound(arr) '添加辅助数据列
    
40.     If Len(arr(j)) > 0 Then arr(j) = arr(j) * -1
    
41.   Next
    
42.   .SeriesCollection.NewSeries
    
43.   .SeriesCollection(i + 1).Values = arr
    
44. 
    
45.   .ChartGroups(1).GapWidth = 0 '列簇间距为0
    
46.   .Legend.Position = xlLegendPositionTop '图例项置顶显示
    
47.   .Legend.LegendEntries(i + 1).Delete '删除辅助列图例
    
48.   .SeriesCollection(i + 1).ApplyDataLabels '设置辅助列数据标签
    
49.   .SeriesCollection(i + 1).DataLabels.Position = xlLabelPositionInsideBase '辅助列数据标签位置为“轴内侧”
    
50.   .SeriesCollection(i + 1).DataLabels.NumberFormatLocal = "[红色]-0;0;;" '辅助列数据标签颜色
    
51.   .SeriesCollection(i + 1).Format.Fill.Visible = msoFalse '辅助列数据系列填充色为无
    
52.   .Axes(xlValue).MajorTickMark = xlNone '无主纵坐标轴刻度线
    
53.   .Axes(xlValue).TickLabelPosition = xlTickLabelPositionHigh '主纵坐标轴标签显示在右侧
    
54.   .Axes(xlValue).Format.Line.Visible = msoFalse '无主纵坐标轴线
    
55. End With
    
56. Set x = Nothing
    
57. End Sub
    
58. 
    

复制代码

cleverzhzhf

悠悠的炊烟 发表于 2014-3-25 21:29
总结

一、        我的构思

请教，是不是对于函数的方法，图例那里，无法实现无数据的就不显示？
也就是，当减少几组纵向的数据时候，图例那里会出现，只有图例的小标志，而没有旁边的文字描述。

悠悠的炊烟

cleverzhzhf 发表于 2014-4-22 11:32
请教，是不是对于函数的方法，图例那里，无法实现无数据的就不显示？
也就是，当减少几组纵向的数据时候 ...

对于这题来说是这个样子的，至少目前我还没找到解决方案。