2022年10月12日 星期三

VBA:一因子變異數分析(ANOVA) VBA版

 分析資料:


圖1.資料


一般EXCEL操作 動畫版:

圖2.運算結果

接下來是小編自己寫的VBA版本:
Sub ONE_WAY_ANOVA()
On Error GoTo LINE1
' ONE ANOVA
RANGE1 = Application.InputBox("選擇資料矩陣的儲存格開始", Type:=8).Address '取得位置
If RANGE1 = "" Then
Exit Sub
End If
RANGE1_TEMP = Mid(InStr(RANGE1, "$") + 1, 1) + 1
RANGE1_TEMP2 = Split(RANGE1, ":")
TEMP1 = Split(RANGE1_TEMP2(0), "$")
TEMP2 = Split(RANGE1_TEMP2(1), "$")
RANGE2 = Application.InputBox("選擇資料矩陣的儲存格範圍", Type:=8).Address '取得位置
If RANGE2 = "" Then
Exit Sub
End If
ALPHA = InputBox("輸入ALPHA值")
If IsNumeric(ALPHA) = False Then
Exit Sub
End If
AVERAGE_ALL = Application.Average(ActiveSheet.Range(RANGE2)) '有帽子的AVERAGE
RANGE2_temp = Split(RANGE2, ":")
TEMP21 = Split(RANGE2_temp(0), "$")
TEMP22 = Split(RANGE2_temp(1), "$")
BEGIN_ROW = Right(RANGE2_temp(0), 1)
END_ROW = Right(RANGE2_temp(1), 1)
Add = 1
SSE_TOTAL = ""
SSTR_TOTAL = ""
SSE_TOTAL_DF = 0
SSTR_TOTAL_DF = 0
For Each i In ActiveSheet.Range(RANGE1)
'For i = BEGIN_ROW To END_ROW Step 1
ADDRESS_TEMP = Split(ActiveSheet.Cells(1, i.Column).Address, "$")
ADDRESS_TEMP_ENDUP = ActiveSheet.Range(ADDRESS_TEMP(1) & 10).End(xlUp).Row
ADDRESS_TEMP2 = Split(ActiveSheet.Range(RANGE1_TEMP2(1)).Address, "$")
ADDRESS_COLUMN = ActiveSheet.Range(RANGE1_TEMP2(1)).Column + 1
Average = Application.Average(ActiveSheet.Range(ADDRESS_TEMP(1) & RANGE1_TEMP & ":" & ADDRESS_TEMP(1) & ADDRESS_TEMP_ENDUP))
'ActiveSheet.Range(ADDRESS_TEMP(1) & ADDRESS_TEMP_ENDUP + 1) = Average
Set SSE_RANGE = ActiveSheet.Range(ADDRESS_TEMP(1) & RANGE1_TEMP & ":" & ADDRESS_TEMP(1) & ADDRESS_TEMP_ENDUP)
For Each J In SSE_RANGE
If SSE_TOTAL = "" Then
SSE_TOTAL = (Average - J.Value) ^ 2
SSE_TOTAL_DF = SSE_TOTAL_DF + 1
' ActiveSheet.Cells(J.Row + END_ROW, J.Column + 6) = SSE_TOTAL
Else
SSE_TOTAL = SSE_TOTAL + (Average - J.Value) ^ 2
SSE_TOTAL_DF = SSE_TOTAL_DF + 1
' ActiveSheet.Cells(J.Row + END_ROW, J.Column + 6) = SSE_TOTAL
End If
'SSTR_TOTAL
If SSTR_TOTAL = "" Then
SSTR_TOTAL = (Average - AVERAGE_ALL) ^ 2
SSTR_TOTAL_DF = SSTR_TOTAL_DF + 1
' ActiveSheet.Cells(J.Row + END_ROW, J.Column) = (Average - AVERAGE_ALL) ^ 2
Else
SSTR_TOTAL = SSTR_TOTAL + (Average - AVERAGE_ALL) ^ 2
SSTR_TOTAL_DF = SSTR_TOTAL_DF + 1
' ActiveSheet.Cells(J.Row + END_ROW, J.Column) = (Average - AVERAGE_ALL) ^ 2
End If
Next
Next
' Set RANGE2_T = ActiveSheet.Range(TEMP21(1) & TEMP21(2) & ":" & TEMP21(1) & TEMP22(2))
For i = TEMP21(2) To TEMP22(2) Step 1
Debug.Print i
Average = Application.Average(ActiveSheet.Range(TEMP1(1) & i & ":" & TEMP2(1) & i))
' ActiveSheet.Cells(i, ADDRESS_COLUMN) = Average
Next
'SSTO
SSTO_Total = ""
SSTO_Total_DF = 0
For Each AA In ActiveSheet.Range(RANGE2)
If SSTO_Total = "" Then
SSTO_Total = (AVERAGE_ALL - AA.Value) ^ 2
SSTO_Total_DF = SSTO_Total_DF + 1
' ActiveSheet.Cells(AA.Row, AA.Column) = (AVERAGE_ALL - AA.Value) ^ 2
Else
SSTO_Total = SSTO_Total + (AVERAGE_ALL - AA.Value) ^ 2
SSTO_Total_DF = SSTO_Total_DF + 1
' ActiveSheet.Cells(AA.Row, AA.Column) = (AVERAGE_ALL - AA.Value) ^ 2
End If
Next
ActiveSheet.Cells(3 + END_ROW, Val(BEGIN_ROW)) = "SS"
ActiveSheet.Cells(6 + END_ROW, BEGIN_ROW - 1) = "SSTO"
ActiveSheet.Cells(4 + END_ROW, BEGIN_ROW - 1) = "SSTR"
ActiveSheet.Cells(5 + END_ROW, BEGIN_ROW - 1) = "SSE"
ActiveSheet.Cells(4 + END_ROW, Val(BEGIN_ROW)) = SSTR_TOTAL
ActiveSheet.Cells(5 + END_ROW, Val(BEGIN_ROW)) = SSE_TOTAL
ActiveSheet.Cells(6 + END_ROW, Val(BEGIN_ROW)) = SSTO_Total
ActiveSheet.Cells(3 + END_ROW, Val(BEGIN_ROW) + 1) = "DF"
ActiveSheet.Cells(4 + END_ROW, Val(BEGIN_ROW) + 1) = TEMP22(2) - TEMP21(2) - 2 'SSTR_TOTAL_DF - 1
ActiveSheet.Cells(5 + END_ROW, Val(BEGIN_ROW) + 1) = SSTO_Total_DF - 1 - (TEMP22(2) - TEMP21(2) - 2)
ActiveSheet.Cells(6 + END_ROW, Val(BEGIN_ROW) + 1) = SSTO_Total_DF - 1
ActiveSheet.Cells(3 + END_ROW, Val(BEGIN_ROW) + 2) = "MS"
ActiveSheet.Cells(4 + END_ROW, Val(BEGIN_ROW) + 2) = SSTR_TOTAL / (TEMP22(2) - TEMP21(2) - 2)
ActiveSheet.Cells(5 + END_ROW, Val(BEGIN_ROW) + 2) = SSE_TOTAL / (SSTO_Total_DF - 1 - (TEMP22(2) - TEMP21(2) - 2))
'ActiveSheet.Cells(6 + END_ROW, Val(BEGIN_ROW) + 2) = SSTO_Total_DF
ActiveSheet.Cells(3 + END_ROW, Val(BEGIN_ROW) + 3) = "F"
ActiveSheet.Cells(4 + END_ROW, Val(BEGIN_ROW) + 3) = ActiveSheet.Cells(4 + END_ROW, Val(BEGIN_ROW) + 2) / ActiveSheet.Cells(5 + END_ROW, Val(BEGIN_ROW) + 2)
ActiveSheet.Cells(3 + END_ROW, Val(BEGIN_ROW) + 4) = "P值"
'ActiveSheet.Cells(4 + END_ROW, Val(BEGIN_ROW) + 4).Formula = FDist(F11, D11, D12)
ActiveSheet.Cells(4 + END_ROW, Val(BEGIN_ROW) + 4) = Application.FDist(ActiveSheet.Cells(4 + END_ROW, Val(BEGIN_ROW) + 3), ActiveSheet.Cells(4 + END_ROW, Val(BEGIN_ROW) + 1).Value, ActiveSheet.Cells(5 + END_ROW, Val(BEGIN_ROW) + 1).Value) 'FDist(F11, D11, D12)
ActiveSheet.Cells(3 + END_ROW, Val(BEGIN_ROW) + 5) = "臨界值"
ActiveSheet.Cells(4 + END_ROW, Val(BEGIN_ROW) + 5) = Application.WorksheetFunction.F_Inv_RT(ALPHA, ActiveSheet.Cells(4 + END_ROW, Val(BEGIN_ROW) + 1).Value, ActiveSheet.Cells(5 + END_ROW, Val(BEGIN_ROW) + 1).Value)
Exit Sub
LINE1:
If Err.Description = "此處需要物件" And Err.Number = 424 Then
Exit Sub
End If
End Sub
view raw gistfile1.txt hosted with ❤ by GitHub


操作GIF:




沒有留言:

張貼留言

指數變化(2025.03.28)

 指數變化(2025.03.28) 上周焦點: 美國消費者信心指數 3/25 92.9 美國耐久財訂單月增率 3/26 1.4 PCE 月增 0.4 年增 2.8 (不多阿,最高還有5.5ㄝ)   本周愛看: 美國非農業就業人數變化 美國ISM製造業採購經理人指數 美國芝加哥FE...