VBA：00632R+VIX

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

圖1.00632R

圖2.VIX

VBA發想：

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

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

   '以下是引用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

EXCEL VBA 關鍵字找檔案名稱

 EXCEL 內建相當多檔案物件與函數可以使用，函數部分最常用的是DIR這個函數，在DOS的年代這個指令是用來列印出目前該目錄內的檔案清單，其實DOS'S DIR與EXCEL的DIR很像!!

不過EXCEL是取得檔案名稱。基本操作參考MSDN：DIR

回歸主題，先把標題變成問題：

如果我們要搜尋關鍵字找檔案名稱應該怎做?

再延伸：如果我們要搜尋關鍵字找檔案名稱應該怎做，又可以防呆?

再延伸一次：如果我們要搜尋多關鍵字找檔案名稱應該怎做，然後又可以防呆?

(把問題想三次，比較好聚焦)

如果我們要搜尋關鍵字找檔案名稱應該怎做?

例如要搜尋2330台積電的EXCEL檔案。

語法：DIR("路徑\2330.xlsm")

Private Sub CommandButton1_Click()

    a = Dir("X:\股票\2330.xlsm")

End Sub

解說：如果有找到則A變數會儲存2330.xlsm的字串資料。

續：

如果我們要搜尋關鍵字找檔案名稱應該怎做，又可以防呆?

試想防呆這情況，為何需要防呆??若以上敘語法有需要其實是不需要的歐，

因為都指定檔案名稱跟副檔名了；反之當僅知道關鍵字時，

例如僅知道2330，則我們需要多一道手續來防呆避免抓錯檔案。

使用INSTR來檢查有無含有指定關鍵字。

類似這樣子：

IF INSTR(FILENAME,"2330")>0 THEN 

END IF 

所以合併一下：

Private Sub CommandButton1_Click()

    a = Dir("X:\股票\2330*.*")

IF INSTR(A,"2330")>0 THEN 

  MSGBOX  "找到了 " & A

END IF 

End Sub

可以加上迴圈作多檔案名稱檢查：

Private Sub CommandButton1_Click()

    a = Dir("X:\股票\*2330*.*")

Do while a<>""

 IF INSTR(A,"2330")>0 THEN    

MSGBOX  "找到了 " & A

END IF 

a = Dir("X:\股票\2330*.*") 

loop 

End Sub

再延伸一次：如果我們要搜尋多關鍵字找檔案名稱應該怎做，然後又可以防呆?

發想:

結合兩個迴圈做不同關鍵字檢查，檢查無誤則把正確檔案明確留下。

Private Sub CommandButton1_Click()

I=1  

  a = Dir("X:\股票\*" & ACTIVESHEET.RANGE("A" & I ).VALUE & "*.*")

Do while a<>""

ACTIVESHEET.RANGE("B" & I )=A '先列出檔名

        J=1 

Do while ACTIVESHEET.RANGE("B" & J) <>""

        IF  INSTR(ACTIVESHEET.RANGE("B" & I).VALUE,

ACTIVESHEET.RANGE("A" & I ).VALUE)=0 THEN 

                   ACTIVESHEET.RANGE("B" & I ).VALUE=""

                 END IF 

J=J+1 

loop 

           I=I+1 

          a = Dir("X:\股票\*" & ACTIVESHEET.RANGE("A" & I ).VALUE & "*.*")

loop

End Sub

東北角

 

Excel VBA FOR 迴圈 簡單教學

 同事卡在迴圈問題，按課本說得，可以作出99乘法表，但是確被書籍的課後練習題卡關了，所以寫在BLOG當作記錄跟分享。

題目：如何使每一列顯示的數字以降冪的方式第一列1到6，第二列1到5方式，直到數字1則結束。

首先先來溫習一下單迴圈行跟列操作，與雙迴圈的標準練習題"99乘法表"。

迴圈三大要素：起始值、結束值/條件、步進值。

結束值/條件：這部分特別說明，不同迴圈操作方式會存在差異，所以不一定是值，在處理某些情況要靠指定條件成立則離開迴圈。

行：

先清除使用中的工作表資料

設定 I 的起始值為1結束為6，每次步進值為1

以CELLS方式控制資料寫入，若單獨要寫在A行，也可以寫成RANGE("A" & I)也行歐

CODE：

ActiveSheet.Cells.Clear

For I = 1 To 6 Step 1

        ActiveSheet.Cells(I, 1) = 1   '
     
Next I

列：

差別在CELLS( 1 , I ) 這部分，要換再把數字 1 改掉即可

CODE：

ActiveSheet.Cells.Clear

For I = 1 To 6 Step 1

        ActiveSheet.Cells(1, I) = 1
     
Next I

雙迴圈：

99乘法表：

先清除使用中的工作表資料

設定 I 迴圈的起始值為1結束為9，每次步進值為1

設定 J 迴圈的起始值為1結束為9，每次步進值為1

Cells(J, I) 為 J 控制列，I 控制行

CODE：

ActiveSheet.Cells.Clear

For I = 1 To 9 Step 1

    For J = 1 To 9 Step 1

        ActiveSheet.Cells(J, I) = I * J
    
    Next J
Next I

回顧一下題目：如何使每一列顯示的數字以降冪的方式第一列1到6，第二列1到5方式，直到數字1集結束。

在這需要發揮一下想像力，當然也很多書籍是當數學問題來看。試著想像一下用雙迴圈，標準輸出會是如下圖數字所示，根據題目要求，反黃的部分是我們不需要的。想像一下似乎能找到一些規則在其中。

第一列0格黃，第2列1格黃，第3列2格黃，第4列3格黃，第5列4格黃，第6列5格黃，對吧!!!!

​

我們再來回顧一下迴圈在運作時，本身的三大要素"起始值、結束值/條件、步進值"，且一設定好，除了起始值外，其他就不能改了。

第一次嘗試：

第一列0格黃，第2列1格黃，第3列2格黃，第4列3格黃，第5列4格黃，第6列5格黃；所以每一列-1，所以寫成  J - (I - 1)：每一列-1

CODE：

ActiveSheet.Cells.Clear

For I = 1 To 6 Step 1

    For J = 1 To 6 Step 1
    
         ActiveSheet.Cells(I, J) = J - (I - 1)
       
    Next J
    
Next I

​

問題：沒想到 J-(I-1)時第一列後，I越來越大，J都是1開始，自然出現負數。如果還是這樣去思考，真的就是個數學問題了，不行!!!這絕對不是一個好的出發點。

重新觀察問題：位置似乎都是固定的，每一行都是固定的數字。所以昇華思考，讓每一行出現應該出現的數字，然後對應每一列作遞減如何??? 在來TRY TRY

說明：將J 迴圈得結束值組合上 I 的開始值再減一。For J = 1 To 6 - (I - 1) Step 1

CODE：

For I = 1 To 6 Step 1

    For J = 1 To 6 - (I - 1) Step 1
    
         ActiveSheet.Cells(I, J) = J
       
    Next J
    
Next I

​

大功告成!!!!!

另解：組合IF條件式作判斷

把原先 J 迴圈的結束值改成 IF 條件式方式去判斷，滿足條件才執行寫入資料。

CODE：

ActiveSheet.Cells.Clear

For I = 1 To 6 Step 1

    For J = 1 To 6 Step 1
    
        If J <= (6 - (I - 1)) Then

            ActiveSheet.Cells(I, J) = J
        
        End If
        
    Next J
    
Next I

腦力激盪一下，來挑戰單迴圈：

組合 IF 判斷式的作法，來作一下變化。

我增加了一個SETP_FINISH的變數作為列的控制。

另外保持原 IF 判斷式概念來判斷資料寫入( I 改成 SETP_FINISH )

但是要寫6行6列ㄝ，I 迴圈則扮演 控制行的角色，SETP_FINISH是列， I 是行。然後增加一個判斷當 I =6時，使起始值 I=0(使下一次迴圈開始時 I+步進值=1)，

SETP_FINISH控制列，則換下一列故為SETP_FINISH+1

似乎少了控制SETP_FINISH的結束值，那我們可以再寫一個 IF 判斷試來判斷 SETP_FINISH滿足大於6時，執行離開迴圈(EXIT FOR)

CODE：

ActiveSheet.Cells.Clear

SETP_FINISH = 1

For I = 1 To 6 Step 1

        If SETP_FINISH > 6 Then
                
            Exit For
        
        End If

        If I <= (6 - (SETP_FINISH - 1)) Then

            ActiveSheet.Cells(SETP_FINISH, I) = I
        
        End If
        
        If I = 6 Then
        
            SETP_FINISH = SETP_FINISH + 1
            
            I = 0
        
        End If
Next I

​

GOOD。分享，程式可以解決數學問題，但別把程式當數學看，多一點想像力跟觀察，自然會走出一條路。

VBA入門：樞紐分析 小工具(列資料隱藏、增加與取消小計)

 

最近寫了各樞紐分析的案子，用了一些小副程式，提供參考。

功能取得樞紐分析表的名稱，列印在即時運算上。

Private Sub CommandButton1_Click()

For A = 1 To ActiveSheet.PivotTables.Count Step 1

    Debug.Print ActiveSheet.PivotTables(A).Name

         Next

End Sub

隱藏列資料的選項。

說明：xlHidden是隱藏，很多人當作刪除資料

Sub DELETE_All_PTFieldsRow()

 For Each pf In ActiveSheet.PivotTables("PivotTable1").RowFields

    pf.Orientation = xlHidden

Next pf

End Sub

資加列的資料，副程式引數為文字資料，直接增加。

Sub PivotTable_ADD(ROW_NAME)

    With ActiveSheet.PivotTables("PivotTable1").PivotFields(ROW_NAME)

        .Orientation = xlRowField

    End With

End Sub

取消各行的小計結果，副程式引數為陣列資料，陣列內須以文字型態設定資料

Sub PivotTable_Subtotals_CANEL(TAG)

Set pt = ActiveSheet.PivotTables(1)

With pt

 For P = LBound(TAG) To UBound(TAG, 2) Step 1

      .PivotFields(TAG(1, P)).Subtotals(1) = True     

     .PivotFields(TAG(1, P)).Subtotals(1) = False

 Next

End With