[已解决]EXCEL中统计分析——在大数组集中寻找最稳态、斜率最小的小数组

香川群子 发表于 2014-8-30 18:21
线性函数关系的自定义函数：本函数可以用于：
已知两点坐标(x1,y1)、(x2,y2)

等我把实际数据拿来，在看看这方法行不行？因为实际数据做出来的图远没有现有的光滑。

香川群子

具体使用肯定有很多细节还需要落实，请楼主上一些真实数据。


附件为误差随机的直线模拟实态计算分析。
我认为斜率k的计算，以取值步长3-5较好。推荐取步长5进行。

直线拟合模拟计算.rar (11.18 KB, 下载次数: 4)

2014-8-31 12:31 上传

点击文件名下载附件

香川群子 发表于 2014-8-31 12:19
具体使用肯定有很多细节还需要落实，请楼主上一些真实数据。

香川群子有心力，谢谢。我会尽快去截取部分数据来请大家看看。

香川群子 发表于 2014-8-30 13:57
没附件。图片也看不到。楼主想自己一个人玩？

数据再次，帮忙看看。谢谢

能否用数学、统计等方法来寻找中间趋向直线的数据段。该方法应该不止针对于本次数据，需要更有广泛性。

香川群子

呵呵，果然不出我所料……你不会分析。

分析是要有技术、有技巧的。


…………
先说结果吧：
取小数点后4位有效数值，则分析计算得到众数最大的斜率值=0.0008

香川群子

为此，又编写了一个求区域斜率k、区域偏移量b的自定义函数 kb

Function f_Line(x, x1, y1, x2, y2, Optional m = 0)
    k = (y1 - y2) / (x1 - x2): If m = 1 Then f_Line = k: Exit Function
    b = (x1 * y2 - x2 * y1) / (x1 - x2): If m = 2 Then f_Line = b: Exit Function
    If m = -1 Then y = x: f_Line = (y - b) / k Else f_Line = k * x + b
End Function

Function kb(xr, yr, Optional m = 1, Optional n = 5, Optional d = 4)
    x = xr.Value: y = yr.Value
    For i = 1 To UBound(x) - n
        t1 = f_Line(0, x(i, 1), y(i, 1), x(i + n, 1), y(i + n, 1), m)
        t = t + f_Line(0, x(i, 1), y(i, 1), x(i + n, 1), y(i + n, 1), m)
    Next
    kb = Round(t / (i - 1), d)
End Function

连续统计 20个数据，以间隔5开始计算斜率，并求其平均值。
偏移量的计算也同样。

香川群子

最后得到的L段模拟直线解析式是：=0.0008*x+0.4575

手工分析很快，下面是要花些时间精力，把它做成自动分析。

香川群子

自动分析、进行直线拟合计算的程序代码完成了。

1. Sub kagawa()
   
2.     tms = Timer
   
3.    
   
4.     m = [a1].End(4).Row
   
5.     ar = [a1].Resize(m, 2)
   
6.    
   
7.     ReDim kr(3 To m - 20)
   
8.     For i = 3 To m - 20
   
9.         t = 0
   
10.         For j = i + 5 To i + 20
    
11.             t = t + (ar(i, 2) - ar(j, 2)) / (ar(i, 1) - ar(j, 1))
    
12.         Next
    
13.         t = Round(t / 16, 5): kr(i) = t
    
14.         If Abs(t - t1) <= 0.0001 Then
    
15.             k = k + 1
    
16.         Else
    
17.             If k > k1 Then k1 = k: s1 = s: s2 = i - 1: t2 = t1
    
18.             k = 1: t1 = t: s = i
    
19.         End If
    
20.     Next
    
21.     Debug.Print s1 & " - " & s2 & ",  k = " & t2
    
22.    
    
23.     t3 = t2
    
24.     For i = 3 To m - 20
    
25.         t = kr(i)
    
26.         If Abs(t - t3) <= 0.0001 Then
    
27.             k = k + 1
    
28.         Else
    
29.             If k > k1 Then k1 = k: s1 = s: s2 = i - 1: t2 = t1
    
30.             k = 1: t1 = t: s = i
    
31.         End If
    
32.     Next
    
33.     Debug.Print s1 & " - " & s2 & ",  k = " & t2
    
34.    
    
35.     t1 = t2: t2 = 0
    
36.     For i = s1 To s2
    
37.         t = kr(i)
    
38.         If t < t1 Then t1 = t
    
39.         If t > t3 Then t3 = t
    
40.         t2 = t2 + t
    
41.         kr(i) = Round(t, 4)
    
42.     Next
    
43.     t2 = Round(t2 / (s2 - s1 + 1), 6): [d2] = t2
    
44.     Debug.Print s1 & " - " & s2 & ",  k = " & t2 & "/" & t1 & "/" & t3
    
45.     [d3].Resize(m - 22) = WorksheetFunction.Transpose(kr)
    
46.    
    
47.     ActiveSheet.ChartObjects("グラフ 3").Activate '此处日文【"グラフ 3"】可能需要修改为【图表 3】
    
48.     ActiveChart.SeriesCollection(1).Formula = "=SERIES(Sheet2!R1C4,,Sheet2!R" & s1 - 40 & "C4:R" & s2 + 40 & "C4,1)"
    
49.     ActiveChart.Axes(xlValue).MinimumScale = Round(t1, 4) - 0.0003
    
50.     ActiveChart.Axes(xlValue).MaximumScale = Round(t3, 4) + 0.0002
    
51.     ActiveWindow.Visible = False
    
52.     [h1].Activate
    
53.    
    
54.     t3 = 0
    
55.     For i = s1 To s2
    
56.         t3 = t3 + ar(i, 2) - t2 * ar(i, 1)
    
57.     Next
    
58.     t3 = Round(t3 / (s2 - s1 + 1), 6): [c2] = t3
    
59.     t = "y = " & Format(t2, "0.000000") & " * x + " & Format(t3, "0.000000")
    
60.     [j1] = t
    
61.     Debug.Print t
    
62.    
    
63.     ReDim cr(3 To m - 20)
    
64.     For i = s1 To s2
    
65.         cr(i) = t2 * ar(i, 1) + t3
    
66.     Next
    
67.     [c3].Resize(m - 22) = WorksheetFunction.Transpose(cr)
    
68.     MsgBox Format(Timer - tms, "0.000s") & vbCr & s1 & " - " & s2 & vbCr & t
    
69. End Sub

复制代码

香川群子 发表于 2014-9-2 17:45
自动分析、进行直线拟合计算的程序代码完成了。

初步了解您说的意思，我自己在消化消化，同时多用几组数据验证一下。
感谢您的帮助，谢谢。
目测选取的直线部分区域似乎偏大.........