澳门威尼斯app下载(www.PinZhi.org)

 找回密码
 加入协会

查看: 187|回复: 16

原创—EXCEL自定义函数完成CPK/PPK/CP/PP/CPU/CPL等的计算

[复制链接]

3

主题

7

帖子

2

精华

澳门威尼斯app下载初级会员

Rank: 2

积分
136
品质币
89
职位
1
发表于 3 天前 | 显示全部楼层 |阅读模式
因为个人加载项文件功能较多包括直方图、帕拉图的宏自动汇制,现只分享部份做品质用的比较多的,自定义函数内容,会使用EXCEL加载项定义的同行朋友,这个原码,可以自己考过去用。再不用复杂的去用软件计算,只要在EXCEL内输入“=cpk(USL,LSL,要分析的数据区域)”回车就可以算出CPK值 了,其它的同理。如果其它的函数也需要,具体可以加QQ89702813讨论。
'################## ppk=min(ppu,ppl)=(1-k)*pp 整体的过程能力指数 带中心值的
Function ppk(USL As Single, LSL As Single, ParamArray rng() As Variant) As Variant
Dim AV  As Single, rang As Range, n As Integer, T As Single, SumN As Single, SE As Single, k As Single
For Each R In rng
If rang Is Nothing Then Set rang = R Else Set rang = Union(rang, R)
For Each c In R
Next
  Next
T = USL - LSL
n = rang.Cells.Count
AV = Application.WorksheetFunction.Average(rang)
For Each R In rang 'rng
     SumN = SumN + Application.WorksheetFunction.Power(R - AV, 2)
   Next
SE = Sqr(SumN / (n - 1)) '计算标准差SE
k = Abs(((((USL + LSL) / 2) - AV) / (T / 2)))
ppk = (1 - k) * T / (SE * 6)
End Function
'################## cpk=min(cpu,cpl)=(1-k)*cp 组间的过程能力指数 带中心值的
Function cpk(USL As Single, LSL As Single, ParamArray rng() As Variant) As Variant
Dim AV  As Single, rang As Range, n As Integer, T As Single, SumN As Single, SE As Single, k As Single
For Each R In rng
If rang Is Nothing Then Set rang = R Else Set rang = Union(rang, R)
For Each c In R
Next
  Next
T = USL - LSL
n = rang.Cells.Count
AV = Application.WorksheetFunction.Average(rang)
For Each R In rang 'rng
     SumN = SumN + Application.WorksheetFunction.Power(R - AV, 2)
   Next
SE = Sqr(SumN / n)
k = Abs(((((USL + LSL) / 2) - AV) / (T / 2)))
cpk = (1 - k) * (T / (SE * 6))
End Function



3

主题

7

帖子

2

精华

澳门威尼斯app下载初级会员

Rank: 2

积分
136
品质币
89
职位
2
 楼主| 发表于 3 天前 | 显示全部楼层
干货!

3

主题

7

帖子

2

精华

澳门威尼斯app下载初级会员

Rank: 2

积分
136
品质币
89
职位
3
 楼主| 发表于 3 天前 | 显示全部楼层
'此过程用户注册自定义函数的帮助
Sub 帮助文件需要放在启动函数内()
    Dim 函数名称 As String        '函数名称
    Dim 函数描述 As String        '函数描述
    Dim 函数类别 As String        '函数类别
    Dim 参数个数(2) As String     '函数参数描述 数组 个数

     函数类别 = "品质使用函数"
    参数个数(0) = "函数参数第1个,规格上限"
    参数个数(1) = "函数参数第2个,规格下限"
    参数个数(2) = "函数参数第3个,用于计算的数据区域"
            函数名称 = "cpk"
            函数描述 = "返回数据的" & 函数名称 & "值"
        Call Application.MacroOptions(Macro:=函数名称, Description:=函数描述, Category:=函数类别, ArgumentDescriptions:=参数个数)
  
End Sub

15

主题

195

帖子

1

精华

澳门威尼斯app下载中级会员

Rank: 3Rank: 3

积分
892
品质币
677
职位
4
居住地
河南省 南阳市
发表于 前天 07:55 | 显示全部楼层

10

主题

1217

帖子

1

精华

澳门威尼斯app下载中级会员

Rank: 3Rank: 3

积分
2305
品质币
1068
职位
5
发表于 前天 08:54 | 显示全部楼层
谢谢分享

0

主题

136

帖子

0

精华

澳门威尼斯app下载中级会员

Rank: 3Rank: 3

积分
2486
品质币
2350
职位
6
发表于 前天 09:07 | 显示全部楼层

0

主题

860

帖子

0

精华

澳门威尼斯app下载中级会员

Rank: 3Rank: 3

积分
2049
品质币
1189
职位
7
发表于 前天 09:11 | 显示全部楼层

1

主题

80

帖子

0

精华

澳门威尼斯app下载初级会员

Rank: 2

积分
301
品质币
221
职位
8
发表于 前天 09:19 | 显示全部楼层

24

主题

1787

帖子

0

精华

澳门威尼斯app下载高级会员

漂泊 尋根的迷途羔羊

Rank: 4

积分
7555
品质币
5768
职位
顧問師
居住地
台湾 台中市
发表于 前天 09:27 | 显示全部楼层
上班中;沒有不會做事的部屬 只有無能的主管。
微信號:hunter5168tw

0

主题

78

帖子

0

精华

澳门威尼斯app下载初级会员

Rank: 2

积分
81
品质币
3
职位
10
发表于 前天 10:34 | 显示全部楼层
您需要登录后才可以回帖 登录 | 加入协会

本版积分规则

简繁转换|Minitab 帮助|图形|DOE|统计|Minitab help|手机版|品质购|澳门威尼斯app下载(www.PinZhi.org)

GMT+8, 2018-9-21 12:40 , Processed in 10.872476 second(s), 23 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

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