在EXCEL中如何制作P控制图的上下控制限?

Haileyhuang

EXCEL中如何实现如下图所示的P控制图的上下限, 源数据在附件. 请帮忙, 谢谢!

Minitab软件做出的P控制图

P_Chart管制图源数据.zip (51.3 KB, 下载次数: 372)

2014-5-30 10:34 上传

点击文件名下载附件
源数据

kanoumatsu

做了一个，你看看

Haileyhuang

非常感谢, 正是我想要的, 关键是如何做? 能否详细解说下, 谢谢!

kanoumatsu

其实您已经做得差不多了，但是UCL和LCL的误差线设定有点问题而已。
请指示观察我图表中误差线的设定就能明白了。
（辅助1和辅助2都是分别用来设定误差线的）
另：关于超出UCL和LCL范围的CL的红点表示，则是通过辅助3来完成，
说白了就是在图中加一条线，但只取超出范围的数。
超出部分的标签显示问题，因为辅助3中的数据是实际数据，而不是所想显示的1，
故通过辅助4的数据来完成显示，具体显示是通过标签替换工具来完成。
标签替换工具为一个VBA宏，具体代码如下；

1. Sub DataLableChange()
   
2. Dim I%, LblCnt%, iRows%, iCols%
   
3. Dim shnm$, sn$, Msg$
   
4. Dim rngLbl As Range
   
5. 
   
6. Select Case TypeName(Selection)
   
7. Case "DataLabel"
   
8.     sn = Selection.Parent.Parent.Name
   
9. Case "DataLabels"
   
10.     sn = Selection.Parent.Name
    
11. Case "Series"
    
12.     sn = Selection.Name
    
13. Case Else
    
14.     MsgBox "请先选中一个系列或系列数据标签再开始使用工具.", vbOKOnly, "提示:选中系列或系列数据标签"
    
15.     Exit Sub
    
16. End Select
    
17. 
    
18. Err.Clear: On Error Resume Next
    
19. Set rngLbl = Application.InputBox("请输入标签所引用的区域,可以用鼠标选择区域.", "标签的引用区域", , , , , , 8)
    
20. Err.Clear: On Error GoTo 0
    
21. If rngLbl Is Nothing Then Exit Sub
    
22. 
    
23. iRows = rngLbl.Rows.Count
    
24. iCols = rngLbl.Columns.Count
    
25. LblCnt = ActiveChart.SeriesCollection(sn).Points.Count
    
26. shnm = rngLbl.Parent.Name
    
27. If Application.Max(iRows, iCols) < ActiveChart.SeriesCollection(sn).Points.Count Then
    
28.     Msg = MsgBox("你所选择的引用单元格小于该系列需要的个数," & Chr(10) & "  选择""Yes""继续," & Chr(10) & "  选择""No""停止执行.", vbYesNo, "引用单元格数量不够")
    
29.     Select Case Msg
    
30.     Case vbYes
    
31.         LblCnt = Application.Max(iRows, iCols)
    
32.     Case vbNo
    
33.         Exit Sub
    
34.     End Select
    
35. End If
    
36. 
    
37. Application.ScreenUpdating = False
    
38. On Error Resume Next
    
39. With ActiveChart.SeriesCollection(sn)
    
40.     For I = 1 To LblCnt
    
41.         Err.Clear
    
42.         .Points(I).ApplyDataLabels
    
43.         If Err.Number = 0 Then
    
44.             If iRows > iCols Then
    
45.                 .Points(I).DataLabel.Text = "='" & shnm & "'!" & rngLbl.Cells(I, 1).Resize(1, iCols).Address(ReferenceStyle:=xlR1C1)
    
46.             Else
    
47.                 .Points(I).DataLabel.Text = "='" & shnm & "'!" & rngLbl.Cells(1, I).Resize(iRows, 1).Address(ReferenceStyle:=xlR1C1)
    
48.             End If
    
49.         End If
    
50.     Next
    
51. End With
    
52. Err.Clear: On Error GoTo 0
    
53. Application.ScreenUpdating = True
    
54. End Sub

复制代码

kanoumatsu

刚刚的图中有点小失误，改了一下，图表看上去更贴近你要的效果。
更改点：添加额辅助5数据。
用来替换系列【不良率】和【不良率2】中的X轴数据。

Haileyhuang

kanoumatsu 发表于 2014-5-30 14:28
其实您已经做得差不多了，但是UCL和LCL的误差线设定有点问题而已。
请指示观察我图表中误差线的设定就能明 ...

真的谢谢啊! 可惜对VBA一点概念都没, 不过此标签显示问题无关紧要.

验证练习先, 再谢!

kanoumatsu

Haileyhuang 发表于 2014-5-30 15:36
真的谢谢啊! 可惜对VBA一点概念都没, 不过此标签显示问题无关紧要.

验证练习先, 再谢!

看了你的信息，又给你做了个步骤。

Haileyhuang

kanoumatsu 发表于 2014-5-30 15:37
看了你的信息，又给你做了个步骤。

非常棒的解说, 谢谢!

levme205

步骤解说太好了。

aman1516

做好记号，好好学习