چهارشنبه, ۲ دی ۱۳۹۴، ۰۳:۵۳ ب.ظ
محاسبه ماکزیمم، مینیمم، میانگین و انحراف معیار مجموعه دلخواه در اکسل
Sub compute()
Dim Arr(8) As Single
Dim Average As Single
Dim Std_Dev As Single
Dim Max As Single
Dim Min As Single
For j = 2 To 4
For i = 1 To 8
Arr(i) = Sheets("Sheet2").Cells(i, j)
Next i
Average = Mean(8, Arr)
Std_Dev = StdDev(8, Arr)
Max = Maximum(8, Arr)
Min = Minimum(8, Arr)
Sheets("Winter").Cells(1, j) = Average
Sheets("Winter").Cells(2, j) = Std_Dev
Sheets("Winter").Cells(3, j) = Max
Sheets("Winter").Cells(4, j) = Min
Next j
End Sub
-------------------------------------------
Function Mean(k As Long, Arr() As Single)
Dim Sum As Single
Dim i As Integer
Sum = 0
For i = 1 To k
Sum = Sum + Arr(i)
Next i
Mean = Sum / k
End Function
-------------------------------------
Function StdDev(k As Long, Arr() As Single)
Dim i As Integer
Dim avg As Single, SumSq As Single
avg = Mean(k, Arr)
For i = 1 To k
SumSq = SumSq + (Arr(i) - avg) ^ 2
Next i
StdDev = Sqr(SumSq / (k - 1))
End Function
--------------------------------------------
Function Maximum(k As Long, Arr() As Single)
Dim i As Integer
Dim Max As Single
Max = Arr(1)
For i = 2 To k
If Arr(i) > Max Then
Max = Arr(i)
End If
Next i
Maximum = Max
End Function
------------------------------------------------
Function Minimum(k As Long, Arr() As Single)
Dim i As Integer
Dim Min As Single
Min = Arr(1)
For i = 2 To k
If Arr(i) < Min Then
Min = Arr(i)
End If
Next i
Minimum = Min
End Function
