甘霖版平溪與十分

 

VBA：使用EXCEL內建函數(APPLICATION、WorksheetFunction)

斜率或截距在VBA基本迴歸入門中有提到使用EXCEL內建函數，這邊簡單介紹一下EXCEL好用的內建函數，如何在EXCEL VBA中直接使用。

2種方式：

application

Application.WorksheetFunction

舉例1：sum函數，透過以上兩種語法結果都是一樣的。

application.sum(activesheet.range("a1:a10"))

Application.WorksheetFunction.sum(activesheet.range("a1:a10"))

但在VBA編輯時，

Application.WorksheetFunction可以自動帶出下拉式選單方便選擇。

圖1.

舉例2：LINEST最小平方法函數，在儲存格使用這個函數時，僅能透過引數控制，

來選擇要回傳斜率或截距等資料，但透過VBA，可以一次取存斜率或截距等資料，

不過是透過陣列的方式。如圖2.

圖2.

	Private Sub CommandButton1_Click()
	s1 = ActiveSheet.Range("A2000").End(xlUp).Row
	B1 = Application.WorksheetFunction.LinEst(ActiveSheet.Range("c2:" & "c" & s1), ActiveSheet.Range("b2:" & "b" & s1))
	If B1(2) > 0 Then
	MsgBox "y=" & Format(B1(1), "##.00") & "+" & Format(B1(2), "##.00") & "x"
	Else
	MsgBox "y=" & Format(B1(1), "##.00") & "-" & Format(B1(2), "##.00") & "x"
	End If
	MsgBox "第二次"
	B1 = Application.LinEst(ActiveSheet.Range("c2:" & "c" & s1), ActiveSheet.Range("b2:" & "b" & s1))
	If B1(2) > 0 Then
	MsgBox "y=" & Format(B1(1), "##.00") & "+" & Format(B1(2), "##.00") & "x"
	Else
	MsgBox "y=" & Format(B1(1), "##.00") & "-" & Format(B1(2), "##.00") & "x"
	End If
	End Sub

view raw LinEst.vba hosted with ❤ by GitHub

草漯

 

VBA：矩陣計算(相加)

矩陣計算：矩陣相加

矩陣是?參WIKI

筆者日前分享了Application.InputBox

利用機會結合一下矩陣計算，做VBA應用分享。

步驟：

1.先做一個VBA，ActiveX按鈕，如圖1.，VBA code：

	'COPYRIGHT BY dropit.liu.
	Private Sub CommandButton1_Click()
	A_INPUTBOX_address = Application.InputBox("", Type:=8).Address '取得位置
	A_INPUTBOX = ActiveSheet.Range(A_INPUTBOX_address).Value '取得資料
	b_INPUTBOX_address = Application.InputBox("", Type:=8).Address '取得位置
	b_INPUTBOX = ActiveSheet.Range(b_INPUTBOX_address).Value '取得資料
	A_CHECK = UBound(A_INPUTBOX)
	B_CHECK = UBound(b_INPUTBOX)
	If A_CHECK <> B_CHECK Then
	MsgBox "矩陣不對稱"
	End If
	For i = LBound(A_INPUTBOX) To UBound(A_INPUTBOX) Step 1
	For j = LBound(A_INPUTBOX) To UBound(A_INPUTBOX) Step 1
	A_INPUTBOX(i, j) = A_INPUTBOX(i, j) + b_INPUTBOX(i, j)
	Next j
	Next i
	Call sheet_name_check_delete("矩陣相加結果")
	Call 矩陣輸出("矩陣相加結果")
	End Sub

view raw 矩陣相加結果.VBA hosted with ❤ by GitHub

	'COPYRIGHT BY dropit.liu.
	Sub sheet_name_check_delete(name_check) '若sheet已存在則刪除
	For I = 1 To Sheets.Count Step 1
	If Sheets(I).Name = name_check Then
	Sheets(I).Delete
	exit for
	End If
	Next I
	End Sub

view raw sheet_name_check_delete hosted with ❤ by GitHub

	'COPYRIGHT BY dropit.liu.
	Sub 矩陣輸出(SHEET_NAME)
	Sheets.Add after:=Sheets(Sheets.Count)
	Sheets(Sheets.Count).Name = SHEET_NAME
	Sheets(SHEET_NAME).Range(A_INPUTBOX_address) = A_INPUTBOX '寫入資料
	Sheets(SHEET_NAME).Range(A_INPUTBOX_address).Interior.Color = QBColor(14) '反黃儲存格
	End Sub

view raw 矩陣輸出.VBA hosted with ❤ by GitHub

1.先選擇放有矩陣的儲存格(A、B兩個矩陣選擇對話框)；

圖1.

圖2.

2.自動產生"矩陣相加結果"工作表，作為結果輸出。

圖3.結果輸出

茶壺山亂走

 

VBA：矩陣計算(常數項乘矩陣)

 矩陣計算：常數項與矩陣相乘

	'COPYRIGHT BY dropit.liu.
	Private Sub CommandButton1_Click()
	A_INPUTBOX_address = Application.InputBox("", Type:=8).Address '取得位置
	A_INPUTBOX = ActiveSheet.Range(A_INPUTBOX_address).Value '取得資料
	If IsArray(A_INPUTBOX) = True Then
	常數 = InputBox("輸入常數數字")
	For i = LBound(A_INPUTBOX) To UBound(A_INPUTBOX) Step 1
	For j = LBound(A_INPUTBOX) To UBound(A_INPUTBOX) Step 1
	A_INPUTBOX(i, j) = 常數 * A_INPUTBOX(i, j)
	Next j
	Next i
	Call sheet_name_check_delete("常數乘矩陣結果")
	Call 矩陣輸出("常數乘矩陣結果")
	End If

view raw 常數乘矩陣結果.vba hosted with ❤ by GitHub

操作類似VBA：矩陣計算(相加)

先選擇放有矩陣的儲存格；

再對話況再輸入常數項

自動產生"常數乘矩陣結果"工作表，作為結果輸出。

整體來說，選擇儲存格>運算>輸出。

輸出部分，小編簡單用一個副程式來整理輸出，此部分可以參考VBA：矩陣計算(相加)。

VBA：使用選擇對話框(Application.InputBox)

 在操作EXCEL時，大家一錠都有一個經驗，在設定某些功能時，

如用分析工具箱時，點選完想要用的分析方法後，

例如圖1.迴歸操作的輸入Y範圍(Y)：；

                                

圖1.迴歸操作

點選後就可以在EXCEL工作頁中選擇要使用的資料範圍。

這個對話框，可以透過Application.InputBox這個方法來滿足。

根據MSDN回饋我們的，要掌握回傳值的結果，要設定TYPE這個參數；

筆者設定為8，也就是"儲存格參照，視為 Range 物件"的回傳值。

EX：

	Private Sub CommandButton1_Click()
	A_INPUTBOX = Application.InputBox("", Type:=8)
	End Sub

view raw Application.InputBox_type:=8.vba hosted with ❤ by GitHub

圖2.選取

圖3.

回傳到A_INPUTBOX變數的情況(筆者沒有放資料在儲存格內 xd)

變更參數設定後，也可以同時輸入文字跟數字歐

EX：

	Private Sub CommandButton1_Click()
	A_INPUTBOX = Application.InputBox("", Type:=1+2)
	End Sub

view raw Application.InputBox_type:=1+2.vba hosted with ❤ by GitHub

圖4.

圖5.變數儲存的結果

假設TYPE設定成，若輸入文字，則會出現錯誤。

圖6.錯誤示範

VBA：基本迴歸入門(分析工具箱-VBA)

 前一篇VBA：基本迴歸入門，講了一點入門的部分，在這補充一點分析工具箱的VBA 引用，請在增益集中選如圖1的部分，別單單僅選分析工具而已歐。要點選分析工具箱-VBA

圖1.

VBA：

小編這邊真的要起立為OFFICE鼓掌，以前在念書的時候，是OFFICE2003，要算迴歸真的不用MINXXAB不行!!出社會公司買一套MINXXAB要X萬，現在跑資料，用這就可以了(其實2010後這功能就好用到不行了，就VBA給他操下去，對不起廢話太多)

短短一行：

	Application.Run "ATPVBAEN.XLAM!Regress", ActiveSheet.Range("$C$2:$C$16"), ActiveSheet.Range("$B$2:$B$16"), False, False, 95, ActiveSheet.Range("$J$1"), True, True, False, True, , True

view raw 分析工具箱-VBA.VBA hosted with ❤ by GitHub

搞定!!!

圖2.

但僅有這樣，怎能跑大量數據!!!

小編簡單提!!

實務上是可以做到以檔案控制方式+透過迴圈+自動判斷跑迴歸+迴歸方程式效度資料整理成報告輸出=迴歸分析報告自動化，完整CODE暫略過，再專文寫成應用篇。

提醒：使用完畢"分析工具箱的VBA "請記得務必取消掛載，因為若你有寫其他自動化的VBA，可能都會收到某些程度上的影響。

迴歸包含有ANOVA、相關分析、簡迴歸、複迴歸、非線性迴歸模式，就一樣一樣來吧!!

因為某位朋友說，這是回饋社會，感恩知恩念恩。

    

VBA：00632R+VIX

 分享小編每日收集的00632R跟VIX的資料：

圖1.00632R

圖2.VIX

VBA發想：

1.透過MSXML2.XMLHTTP，GET方法將資料自動化擷取回來。

	'COPYRIGHT BY dropit.liu.
	With CreateObject("MSXML2.XMLHTTP")
	.Open "get", A, flase '開啟網頁
	.send
	Do Until .readyState = 4 '確認網頁狀態
	DoEvents
	Application.Wait DateAdd("s", 0.3, Now) '等待時間
	If temp_time = "" Then
	temp_time = Now()
	Else
	TIME_BETWEEN = DateDiff("s", temp_time, Now()) '計算花費時間
	If temp > 1 Then
	checklink = 0
	'MsgBox "check = 0"
	Exit Function '包在FUNCTION 中時用EXIT FUNCTION 若是改包成在SUB中則改為EXIT SUB
	End If
	End If
	Loop
	M_DATA = .responseText '取得資料站存在M_DATA中
	M1 = .responseBody '測試用：回傳不同的結構
	lValue = .Status '測試用：收集狀態
	lValue_2 = .readyState '測試用：收集狀態
	If M_DATA = "" Then
	GoTo LINE1 '沒回傳資料的處理
	End If
	End With

view raw MSXML2.XMLHTTP_BY_GET_MODULE.VBA hosted with ❤ by GitHub

2.整理資料

3.繪製成圖

4.檢查日期是否為最新，若否持續執行直到最新日期。

概念股 2020.11月營收整理

資料整理參考!!

 BLOG版資料下載

VBA：基本迴歸入門

 迴歸基本概念：

2變數 X與Y之間的統計關係，為一非確定值得關係，當X的值確定後，Y的值並非唯一恆定值。而用以表示如此2變數X與Y間的數學模式稱為迴歸方程式或機遇模式。

圖1.

如圖1體重與身高的散佈圖，身高(X)與體重(Y)的關係，身高(X)為因變數，體重(Y)則為反應變數；我們通常在統計推論中，藉由一組樣本資料及統計學中相關理論找出變數間的統計關係，以區分變數，建立適當的數學模式來表示變數間的統計關係，並稱此等數學模式為迴歸方程式；而運用樣本資料配適一個最佳數學模式的統計學方法與過程，稱之為迴歸分析。

迴歸分析的線性模型可以以自變數個數做分類，含有一個自變數稱為簡單迴歸，含有2個或2個以上則稱為複迴歸。

迴歸分析既然是統計推論，自然有其必要基本假設要驗證，小編強調是針對樣本歐，迴歸分析有三個基本特性的檢定：常態性檢定、同質性檢定與隨機性檢定，這三個檢定有機會在聊聊。

回到主題，我們簡單整理一個例子。💪

簡單線性迴歸的長相：

透過最小平方法求兩個B0、B1的參數：

               

舉例：

某一保險公司想要調查火災損失和火災發生地與最近的消防展的距離關係。進行某城市案例資料統計如表。

哇，實在是太學術了!!!😰

開始把題目資料整理成EXCEL先......😀

先把資料堆壘：

圖2.

Excel版：透過EXCEL內建的分析工具箱，點選好資料後如下。

圖3.

結果：

圖4.

圖5.

簡單說明，基本上R平方與調整後R平方(又稱判定係數)，越靠近1表示迴歸方程式對資料的解釋能力越好，但還是要提醒一下也要看一下ANOVA分析中迴歸、殘差與總和的關係(這太統計了，小編先PASS)。

改用VBA來玩玩看😎

VBA版(用最小平方法函數；LinEst)：

	Private Sub CommandButton1_Click()
	s1 = ActiveSheet.Range("A2000").End(xlUp).Row
	B1 = Application.WorksheetFunction.LinEst(ActiveSheet.Range("c2:" & "c" & s1), ActiveSheet.Range("b2:" & "b" & s1))
	If B1(2) > 0 Then
	MsgBox "y=" & Format(B1(1), "##.00") & "+" & Format(B1(2), "##.00") & "x"
	Else
	MsgBox "y=" & Format(B1(1), "##.00") & "-" & Format(B1(2), "##.00") & "x"
	End If
	End Sub

view raw regression_LinEst.vba hosted with ❤ by GitHub

Private Sub CommandButton1_Click()

    s1 = ActiveSheet.Range("A2000").End(xlUp).Row

   '以下是引用excel內建函數

    b1 = Application.WorksheetFunction.LinEst(ActiveSheet.Range("c2:" & "c" & s1), ActiveSheet.Range("b2:" & "b" & s1))

    '在儲存格中使用僅會回傳一筆資料，

    '但vba時會回傳一個陣列的結果，內含b0與b1兩個迴歸的參數。

    If b1(2) > 0 Then

    

        MsgBox "y=" & Format(b1(1), "##.00") & "+" & Format(b1(2), "##.00") & "x"

    

    Else

    

        MsgBox "y=" & Format(b1(1), "##.00") & "-" & Format(b1(2), "##.00") & "x"

    

    End If

    

End Sub

執行結果：

圖6.

好像跟用資料分析功能少了很多東西!!!

少了很重要的"判定係數"💭

來整理一下總變異(SST)，迴歸變異(SSR)與無法解釋的變異(SSE)的公式，

並看看判定係數怎求😆

判定係數公式：

SST=SSR+SSE

修改程式：

流程：

1.先載入資料轉換為一維陣列。

2.開始計算B1、B0參數找出迴歸方程式。

3.計算 SST SSR SSE ERROR Y預測值

4.計算判定係數

5.輸出結果

Sub CommandButton1_Click()

        

        'LOAD DATA

        

         s1 = ActiveSheet.Range("A2000").End(xlUp).Row

         

         Y = ActiveSheet.Range("c2:" & "c" & s1)

         

         Y = WorksheetFunction.Transpose(Y)

         

         AVERAGE_Y = Application.Sum(Y) / UBound(Y)

         

         X = ActiveSheet.Range("b2:" & "b" & s1)

         

         X = WorksheetFunction.Transpose(X)

         

         AVERAGE_X = Application.Sum(X) / UBound(X)

         

         'REDIM ARRAY

         

         ReDim B1_1(UBound(X))

         

         ReDim B1_2(UBound(X))

         

         '計算 B1

         For A = LBound(X) To UBound(X) Step 1

                    

                    B1_1(A) = ((X(A) - AVERAGE_X) * (Y(A) - AVERAGE_Y))

                    

                    B1_2(A) = (X(A) - AVERAGE_X) ^ 2

                    

         Next A

         

         B1 = Application.Sum(B1_1) / Application.Sum(B1_2)

         

         '計算 B0

         B0 = AVERAGE_Y - B1 * AVERAGE_X

        

        '計算 SST SSR SSE ERROR Y預測值

        

        ReDim SSR(UBound(Y))

        

        ReDim SSE(UBound(Y))

        

        ReDim Y_HAT(UBound(Y))

        

        ReDim ERROR_DIS(UBound(Y))

        

         For A = LBound(Y) To UBound(Y) Step 1

            

            SSR(A) = ((B0 + B1 * X(A)) - AVERAGE_Y) ^ 2

            

            SSE(A) = (Y(A) - (B0 + B1 * X(A))) ^ 2

            

            Y_HAT(A) = (B0 + B1 * X(A))

            

            ERROR_DIS(A) = Y(A) - Y_HAT(A)

            

        Next A

                

        SST = Application.Sum(SSR) + Application.Sum(SSE)

        

        SSR_TOTAL = Application.Sum(SSR)

        

        R = SSR_TOTAL / SST '判斷係數

        

        R_root = R ^ 0.5 '取根號

        

        '輸出        

        ActiveSheet.Range("D1:" & "D" & s1) = WorksheetFunction.Transpose(Y_HAT)

        

        ActiveSheet.Range("E1:" & "E" & s1) = WorksheetFunction.Transpose(ERROR_DIS)

        

        ActiveSheet.Range("D1:" & "F" & 1) = Array("預測 Y", "殘差")

    ActiveSheet.Range("F1") = "迴歸模型："

        

    If B1 > 0 Then

        

       ActiveSheet.Range("g1") = "y=" & Format(B0, "##.00") & "+" & Format(B1, "##.00") & "x"

       

    Else

    

        ActiveSheet.Range("G1") = "y=" & Format(B0, "##.00") & "-" & Format(B1, "##.00") & "x"

      

    End If

    

    ActiveSheet.Range("F2") = "判斷係數："

    

    ActiveSheet.Range("G2") = Format(R, "##.00%")

    

    

    ActiveSheet.Range("F3") = "R 的倍數："

    

    ActiveSheet.Range("G3") = Format(R_root, "##.00%")

    

End Sub

結果：

圖7.

圖8.

對答案(EXCEL 內建的分析工具箱)：

圖9.

圖10.

下一篇：運用EXCEL內建工具箱以VBA完成

另外借文章感謝一個朋友，感謝他提醒分享的重要。

疫情期間大家要健康!!!😆😆

相關文章：

VBA：股價相關係數、判定係數分析自動化~我超愛看錄影帶(VHS)!!!

VBA：相關係數；Correl