' 窗体控件说明:
' Text1(0)~Text1(n-1):测量值输入文本框数组
' Command1:计算按钮
' Command2:导出报告按钮
' Label2:显示计算结果
' CommonDialog1:保存文件对话框
Option Explicit
Private Sub Command1_Click()
Dim n As Integer, i As Integer
Dim sumDiffSq As Double, s As Double
Dim x() As Double
' 获取测量次数(文本框数组元素个数)
n = Text1.UBound + 1
If n < 2 Then
MsgBox "测量次数至少需要2次", vbCritical
Exit Sub
End If
' 读取输入数据
ReDim x(0 To n - 1)
On Error GoTo inputErr
For i = 0 To n - 1
x(i) = Val(Text1(i).Text)
Next
' 较差法计算标准偏差
sumDiffSq = 0
For i = 0 To n - 2
sumDiffSq = sumDiffSq + (x(i + 1) - x(i)) ^ 2
Next
s = Sqr(sumDiffSq / (2 * (n - 1)))
' 显示结果
Label2.Caption = "单次测量实验标准偏差:s = " & Format(s, "0.0000") & vbCrLf & _
"算术平均值标准偏差:s(avg) = " & Format(s / Sqr(n), "0.0000")
Exit Sub
inputErr:
MsgBox "第" & i + 1 & "个测量值输入错误,请输入数字", vbCritical
End Sub
' 导出计算报告
Private Sub Command2_Click()
Dim fso As Object, ts As Object
Dim savePath As String
Dim n As Integer, i As Integer
CommonDialog1.Filter = "文本文件(*.txt)|*.txt|所有文件(*.*)|*.*"
CommonDialog1.ShowSave
If CommonDialog1.FileName = "" Then Exit Sub
savePath = CommonDialog1.FileName
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile(savePath, True)
ts.WriteLine "计量较差法计算报告"
ts.WriteLine "生成时间:" & Now
ts.WriteLine "=============================="
ts.WriteLine "测量值序列:"
n = Text1.UBound + 1
For i = 0 To n - 1
ts.WriteLine "x" & i + 1 & " = " & Text1(i).Text
Next
ts.WriteLine "=============================="
ts.WriteLine Label2.Caption
ts.WriteLine "=============================="
ts.WriteLine "依据:JJF 1059.1-2012《测量不确定度评定与表示》"
ts.Close
MsgBox "报告已导出至:" & savePath, vbInformation
End Sub
' 动态添加测量值输入框
Private Sub Form_Load()
Dim i As Integer, txt As TextBox
' 默认生成10个输入框(可根据需要调整数量)
For i = 1 To 10
Set txt = Controls.Add("VB.TextBox", "Text1" & i, Me)
txt.Index = i - 1
txt.Left = 100
txt.Top = 100 + (i - 1) * 400
txt.Width = 2000
txt.Height = 300
txt.Visible = True
' 添加标签
Set lbl = Controls.Add("VB.Label", "Label1" & i, Me)
lbl.Left = 2200
lbl.Top = 100 + (i - 1) * 400
lbl.Width = 1000
lbl.Height = 300
lbl.Caption = "测量值" & i
lbl.Visible = True
Next
End Sub
用VBA就可以实现了 |