excel学习库

excel表格_excel函数公式大全_execl从入门到精通

Excel VBA函数源码分享,随机生产SPC数据

大家好,今天给大家带来的是 VBA 源码,文档在网盘中免费送给大家,有需要的请评论“学习”再私信给我“SPC”获取下载地址。 将以下代码复制到模块中。

01 module 模块代码

Sub ReData() '生成新数据 Dim Cup As Double, Clp As Double '声明尺寸上下限 Dim Ctop As Double, Cbot As Double '声明控制上下限 Dim R As Double '声明极差 Dim Jd As Double '声明精度 Dim Kng As Double '声明可控性 Dim Ponits As Integer '声明小数点精度 Dim PointSTR As String '声明小数点格式 With Sheet3 '设置 Sheet3 工作表变量块 Cup = Val(.Cells(4, "T").Text) '在表中获取尺寸上限 Clp = Val(.Cells(4, "P").Text) '在表中获取尺寸下限 R = Format(Abs(Cup - Clp), "0.0000") '求尺寸上限与下限的极差,并格式为四位小数 Jd = Val(.Cells(2, "R").Text) '在表中获取要求的精度 Kng = Val(.Cells(3, "R").Text) '求尺寸可控性 Points = Val(.Cells(2, "S").Text) '在表中获取要求保留的小数点位数 For i = 0 To Points - 1 '循环设置小数点位数的格式文本 PointSTR = PointSTR & "0" Next i PointSTR = "0." & PointSTR '最终格式文本 If Jd <= 0 Then '判断所设置的精度是否可控 MsgBox "CPK 精度不能<=0", 48, "错误" Exit Sub End If Ctop = Format(Cup - (R / 2) * (Jd / 100), "0.000") '求随机数控制的下限 Cbot = Format(Clp + (R / 2) * (Jd / 100), "0.000") '求随机数控件的上限 'MsgBox Ctop & " " & Cbot If Ctop <= Cbot Then '判断控制是否大于下限 MsgBox "精度不可控", 48, "错误" Exit Sub End If For i = 2 To 21 '循环生成随机数 For j = 6 To 10 .Cells(j, i) = Format(GetRnd(Ctop, Cbot), PointSTR) '调用随机数生成过程,并返回到单元格中。 Next j Next i End With End Sub

02 以下是获取随机数过程

Function GetRnd(TopNumber As Double, BotNumber As Double) As Double '获取随机数 If TopNumber = BotNumber Then '如果上下限相等 MsgBox "上限与下限不能相等", 64, "错误" GetRnd = 0 Exit Function ElseIf TopNumber < BotNumber Then '如果上限小于下限 MsgBox "上限不能小于下限", 64, "错误" GetRnd = 0 Exit Function End If Dim RndNumber As Double RndNumber = Rnd() * BotNumber + BotNumber ' + 1 Do While RndNumber < BotNumber Or RndNumber > TopNumber RndNumber = Rnd() * BotNumber + BotNumber ' + 1 Loop GetRnd = RndNumber End Function

发表评论:

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。

«    2024年12月    »
1
2345678
9101112131415
16171819202122
23242526272829
3031
控制面板
您好,欢迎到访网站!
  查看权限
网站分类
搜索
最新留言
    文章归档
      友情链接