Chinaunix首页 | 论坛 | 博客
  • 博客访问: 1676208
  • 博文数量: 585
  • 博客积分: 14610
  • 博客等级: 上将
  • 技术积分: 7402
  • 用 户 组: 普通用户
  • 注册时间: 2008-05-15 10:52
文章存档

2013年(5)

2012年(214)

2011年(56)

2010年(66)

2009年(44)

2008年(200)

分类: C/C++

2008-08-15 09:03:39

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

Js代码 复制代码
  1. '==============================================  
  2. '作者:大漠.jxzhoumin  
  3. '创作时间:2008.6.2  
  4. '==============================================  
  5. Private Sub CommandButton1_Click()  
  6. Call main  
  7. End Sub  
  8. Sub main()  
  9. Dim s1_0, s2_0, s3_0 As Integer  
  10. Dim s1, s2, s3 As Integer  
  11. Dim n As Integer, x As Integer  
  12. Dim at, bt, ct As Integer  
  13. Dim a As Double  
  14. Dim t As Integer  't  
  15. Dim tt As Integer 'T  
  16. If Trim(TextBox1.Text) = "" Then  
  17.    MsgBox "t值不能为空!,请输入该值!"  
  18.    Exit Sub  
  19. End If  
  20. If Trim(TextBox2.Text) = "" Then  
  21.    MsgBox "T值不能为空!,请输入该值!"  
  22.    Exit Sub  
  23. End If  
  24. If Trim(TextBox4.Text) = "" Then  
  25.    MsgBox "a值不能为空!,请输入该值!"  
  26.    Exit Sub  
  27. End If  
  28. a = Val(Trim(TextBox4.Text))  
  29. n = tj("sheet1") - 1  
  30. With Worksheets("sheet1")  
  31. s1_0 = (Val(.Cells(2, 2).Value + .Cells(3, 2).Value + .Cells(4, 2).Value)) / 3  
  32. s2_0 = s1_0  
  33. s3_0 = s2_0  
  34. For i = 1 To n  
  35.     x = .Cells(i + 1, 2).Value  
  36.     If i = 1 Then  
  37.         s1 = a * x + (1 - a) * s1_0  
  38.         s2 = a * s1 + (1 - a) * s2_0  
  39.         s3 = a * s2 + (1 - a) * s3_0  
  40.     Else  
  41.         s1 = a * x + (1 - a) * .Cells(i, 3).Value  
  42.         s2 = a * s1 + (1 - a) * .Cells(i, 4).Value  
  43.         s3 = a * s2 + (1 - a) * .Cells(i, 5).Value  
  44.     End If  
  45.     .Cells(i + 1, 3).Value = Int(s1 + 0.5)  
  46.     .Cells(i + 1, 4).Value = Int(s2 + 0.5)  
  47.     .Cells(i + 1, 5).Value = Int(s3 + 0.5)  
  48. Next i  
  49. t = Val(Trim(TextBox1.Text))  
  50. tt = Val(Trim(TextBox2.Text))  
  51. i = 0  
  52. Do  
  53.     i = i + 1  
  54.     If t = .Cells(i + 1, 1) Then  
  55.         s1 = .Cells(i + 1, 3).Value  
  56.         s2 = .Cells(i + 1, 4).Value  
  57.         s3 = .Cells(i + 1, 5).Value  
  58.         x = .Cells(i + 1, 2).Value  
  59.         Exit Do  
  60.     End If  
  61. Loop Until i > n  
  62. at = 3 * s1 - 3 * s2 + s3  
  63. bt = (a / (2 * ((1 - a) ^ 2))) * ((6 - 5 * a) * s1 - 2 * (5 - 4 * a) * s2 + (4 - 3 * a) * s3)  
  64. ct = (a ^ 2 / (2 * ((1 - a) ^ 2))) * (s1 - 2 * s2 + s3)  
  65. TextBox3.Text = Int(at + bt * tt + ct * (tt ^ 2) + 0.5)  
  66. TextBox5.Text = Int(at + 0.5)  
  67. TextBox6.Text = Int(bt + 0.5)  
  68. TextBox7.Text = Int(ct + 0.5)  
  69. End With  
  70. End Sub  
  71. Function tj(lb) As Integer  
  72.      Dim k As Integer  
  73.      k = 2  
  74.      Do  
  75.          Set myR = Sheets(lb).Cells(k, 1)  
  76.          If Trim(myR.Value) = "" Then     '出现空记录  
  77.             Exit Do  
  78.          End If  
  79.          k = k + 1  
  80.      Loop Until False  
  81.      tj = k - 1  
  82. End Function 
阅读(1266) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~