三次指数平滑法的预测

昨天晚上帮同学完成三次指数平滑法的预测模型算法实现，这个就很简单了。

'==============================================
'作者：大漠.jxzhoumin
'创作时间：2008.6.2
'==============================================
Private Sub CommandButton1_Click()
Call main
End Sub
Sub main()
Dim s1_0, s2_0, s3_0 As Integer
Dim s1, s2, s3 As Integer
Dim n As Integer, x As Integer
Dim at, bt, ct As Integer
Dim a As Double
Dim t As Integer  't
Dim tt As Integer 'T
If Trim(TextBox1.Text) = "" Then
   MsgBox "t值不能为空！，请输入该值！"
   Exit Sub
End If
If Trim(TextBox2.Text) = "" Then
   MsgBox "T值不能为空！，请输入该值！"
   Exit Sub
End If
If Trim(TextBox4.Text) = "" Then
   MsgBox "a值不能为空！，请输入该值！"
   Exit Sub
End If
a = Val(Trim(TextBox4.Text))
n = tj("sheet1") - 1
With Worksheets("sheet1")
s1_0 = (Val(.Cells(2, 2).Value + .Cells(3, 2).Value + .Cells(4, 2).Value)) / 3
s2_0 = s1_0
s3_0 = s2_0
For i = 1 To n
    x = .Cells(i + 1, 2).Value
    If i = 1 Then
        s1 = a * x + (1 - a) * s1_0
        s2 = a * s1 + (1 - a) * s2_0
        s3 = a * s2 + (1 - a) * s3_0
    Else
        s1 = a * x + (1 - a) * .Cells(i, 3).Value
        s2 = a * s1 + (1 - a) * .Cells(i, 4).Value
        s3 = a * s2 + (1 - a) * .Cells(i, 5).Value
    End If
    .Cells(i + 1, 3).Value = Int(s1 + 0.5)
    .Cells(i + 1, 4).Value = Int(s2 + 0.5)
    .Cells(i + 1, 5).Value = Int(s3 + 0.5)
Next i
t = Val(Trim(TextBox1.Text))
tt = Val(Trim(TextBox2.Text))
i = 0
Do
    i = i + 1
    If t = .Cells(i + 1, 1) Then
        s1 = .Cells(i + 1, 3).Value
        s2 = .Cells(i + 1, 4).Value
        s3 = .Cells(i + 1, 5).Value
        x = .Cells(i + 1, 2).Value
        Exit Do
    End If
Loop Until i > n
at = 3 * s1 - 3 * s2 + s3
bt = (a / (2 * ((1 - a) ^ 2))) * ((6 - 5 * a) * s1 - 2 * (5 - 4 * a) * s2 + (4 - 3 * a) * s3)
ct = (a ^ 2 / (2 * ((1 - a) ^ 2))) * (s1 - 2 * s2 + s3)
TextBox3.Text = Int(at + bt * tt + ct * (tt ^ 2) + 0.5)
TextBox5.Text = Int(at + 0.5)
TextBox6.Text = Int(bt + 0.5)
TextBox7.Text = Int(ct + 0.5)
End With
End Sub
Function tj(lb) As Integer
     Dim k As Integer
     k = 2
     Do
         Set myR = Sheets(lb).Cells(k, 1)
         If Trim(myR.Value) = "" Then     '出现空记录
            Exit Do
         End If
         k = k + 1
     Loop Until False
     tj = k - 1
End Function

  

评论

1 楼 rentutu 2008-11-14  

lz真辛苦，可是为什么下不了呢~！！都3天了~~！！