VBA_善用陣列能縮短程序執行時間

         下面VBA代碼是用來做單價查詢，利用TRIMMEAN函數將20%的極端值排除求出平均數，在以STDEV.S求得標準差，然後計算標準差佔坪均數的比例，比例越高代表這個品號價格波動越大，用在採購單價及銷售單價上有不錯的篩選效果。

        在這裡是使用一般平均數計算也可以達到效果，因為每個單價如果差異大標準差就會大，也就會顯示高差異比例。

        陣列在VBA使用上能節省很多時間，在這例子上不使用陣列需要花33秒，這讓我有點難接受，後來改陣列計算，縮短為7秒左右，勉強能接受，下面提供部分代碼，有興趣的人可以參考一下。

Sub 單價偏鋒_標準差()

    '2020/11/25 此方式須33秒(跟資料範圍有關)

    Application.ScreenUpdating = False

    t = Timer

    Dim sh_樞紐 As Worksheet

    Set sh_樞紐 = Sheets("樞紐")

    With sh_樞紐

        lr = .Range("A1048576").End(xlUp).Row

        lc = .Range("A2").End(xlToRight).Column

        For i = 3 To lr

            .Cells(i, lc + 1) = "=IFERROR(TRIMMEAN(RC[-60]:RC[-1],0.2),"""")"

            .Cells(i, lc + 2) = "=IFERROR(int(STDEV.S(RC[-61]:RC[-2])),"""")"

            .Cells(i, lc + 1) = .Cells(i, lc + 1).Value

            .Cells(i, lc + 2) = .Cells(i, lc + 2).Value

            If .Cells(i, lc + 2) > 0 Then

                .Cells(i, lc + 3) = Round(.Cells(i, lc + 2) / .Cells(i, lc + 1), 2)

            End If

        Next

    End With

    MsgBox Timer - t

End Sub

Sub 單價偏鋒_標準差A()

    '2020/11/25 此方式約6秒 ，如果輸出""會變7秒，增加截取最近一年最高價時間約7.2秒

    Application.ScreenUpdating = False

    t = Timer

    Dim sh_樞紐 As Worksheet

    Set sh_樞紐 = Sheets("樞紐")

    With sh_樞紐

        lr = .Range("A1048576").End(xlUp).Row

        lc = .Range("A2").End(xlToRight).Column

        .Columns(lc + 1).Resize(, 2).NumberFormatLocal = "#,###"

        .Columns(lc + 3).NumberFormatLocal = "#.00%"

        .Columns(lc + 4).NumberFormatLocal = "#,###"

       ' arr_樞紐 = .Range("A1").Resize(lr, lc + 3) 可能是記憶體關係，計算完無法撈出來，不然整體會落在1秒內

        For i = 3 To lr

            arr_暫時 = .Cells(i, lc - 59).Resize(, 60) '----------差異點

            arr_最近 = .Cells(i, lc - 11).Resize(, 12) '----------新增步驟

            If Application.Sum(arr_暫時) > 0 Then

                .Cells(i, lc + 1) = Application.TrimMean(arr_暫時, 0.2)

                in_標準差 = Application.StDev_S(arr_暫時)

                If IsError(in_標準差) Then

                    .Cells(i, lc + 2) = 0 '輸出"" 會比輸出0 多1秒

                Else

                    .Cells(i, lc + 2) = Application.StDev_S(arr_暫時)

                End If

            Else

               .Cells(i, lc + 2) = 0

               .Cells(i, lc + 1) = 0

            End If

            in_T平均 = .Cells(i, lc + 1)

            in_標準差 = .Cells(i, lc + 2)

            If in_標準差 > 0 Then

                .Cells(i, lc + 3) = Application.Round(in_標準差 / in_T平均, 2)

            End If

            in_最高價 = Application.Max(arr_最近) '-----增加此步驟

            If in_最高價 > 0 Then '避免不必要輸出，減少時間

                .Cells(i, lc + 4) = in_最高價

            End If

            Erase arr_最近

            Erase arr_暫時

        Next

    End With

    MsgBox Timer - t

End Sub