Excel VBA 實戰(5)

上代碼。

在程序的領域，惟一可以限制你的只有你的想像力。

函數式編程與VBA結合，為實戰項目提供無限可能性。

Option ExplicitnnPublic Sub main()n 測試 數組後兩位為空值n Dim inn Dim arr(1 To 10)n n For i = 1 To 8n arr(i) = 1n Next in n arrToStr 將數組轉化為字元串，代碼解析參考 基礎教程部分n 空值默認為 0， 下列模式可以計算凈現值，折現率為10%n Debug.Print arrToStr(map(arr, "_/1.1^{i}", , , False))n 求出數組中字元串的長度之和n Debug.Print arrToStr(reduce(Array("Qiou", "yang", "sgfxq"), "{v}+len(_)", 0, , , , , "", True))n 取出各字元串左邊兩個字元n Debug.Print arrToStr(map(Array("Qiou", "yang", "sgfxq"), "left(_, 2)", , , False, "", True))nnEnd Subnn 函數式之reducen arr 為目標數組n operation 為函數的字元串表示n initVal 為初始值 默認為0n placeholder 為數組元素佔位符 默認為_n index 為對應索引佔位符 默認為{i}n cumVal 為初始值佔位符 默認為{v}n hasThousandSep 是否有歐洲版千位分隔符， 因為歐洲版Excel千位分隔符與國內小數點一樣，會造成運行時錯誤，國內版Excel傳否n valNull 如果為空值時的替換值n asStrParam 如果將數組元素以字元串形式傳為參數nPrivate Function reduce(ByRef arr, ByVal operation As String, Optional ByVal initVal As Variant = 0, Optional ByVal placeholder As String = "_", Optional ByVal index As String = "{i}", Optional ByVal cumVal As String = "{v}", Optional ByVal hasThousandSep As Boolean = True, Optional ByVal valIfNull As Variant = 0, Optional ByVal asStrParam As Boolean = False) As Variantn Dim kn Dim vn Dim tmp As Stringn n 如果為字元形式 則千位分隔符設定無意義n If asStrParam Thenn hasThousandSep = Falsen End Ifn n 如果有歐洲版千位分隔符 即"," 先將 "," 替換為 "."n If hasThousandSep Thenn For k = LBound(arr) To UBound(arr)n 先排除空值n tmp = Replace(IIf(IsEmpty(arr(k)), valIfNull, arr(k)) & "", ",", ".")n initVal = Replace(initVal & "", ",", ".")n 將各元素進行相應替代 並求值n initVal = Application.Evaluate(Replace(Replace(Replace(operation, placeholder, tmp), index, k), cumVal, initVal))n Next kn Elsen For k = LBound(arr) To UBound(arr)n tmp = IIf(IsEmpty(arr(k)), valIfNull, arr(k))n 為字元串形式的參數n If asStrParam Thenn tmp = """" & tmp & """"n End Ifn 將各元素進行相應替代 並求值n initVal = Application.Evaluate(Replace(Replace(Replace(operation, placeholder, tmp), index, k), cumVal, initVal))n Next kn End Ifnn reduce = initValnEnd Functionnn 函數式之mapn 各參數與reduce相同n 原理與reduce類似nPrivate Function map(ByRef arr, ByVal operation As String, Optional ByVal placeholder As String = "_", Optional ByVal index As String = "{i}", Optional ByVal hasThousandSep As Boolean = True, Optional ByVal valIfNull As Variant = 0, Optional ByVal asStrParam As Boolean = False) As Variantn Dim kn Dim vn Dim tmp As Stringn n If asStrParam Thenn hasThousandSep = Falsen End Ifn n If hasThousandSep Thenn For k = LBound(arr) To UBound(arr)n tmp = Replace(IIf(IsEmpty(arr(k)), valIfNull, arr(k)) & "", ",", ".")n arr(k) = Application.Evaluate(Replace(Replace(operation, placeholder, tmp), index, k))n Next kn Elsen For k = LBound(arr) To UBound(arr)n n tmp = IIf(IsEmpty(arr(k)), valIfNull, arr(k))n n If asStrParam Thenn tmp = """" & tmp & """"n End Ifn n Debug.Print tmpn n arr(k) = Application.Evaluate(Replace(Replace(operation, placeholder, tmp), index, k))n Next kn End Ifnn map = arrnEnd Functionnn將數組轉換為字元串n講解請參見 基礎教程部分nPrivate Function arrToStr(ByRef arr) As Stringnn Dim res As Stringnn Dim inn If IsArray(arr) Thennn If UBound(arr) - LBound(arr) + 1 = 0 Thenn res = "[ ]"n Elsenn res = "["nn For i = LBound(arr) To UBound(arr)nn res = res & arrToStr(arr(i)) & ", "n Next inn res = Left(res, Len(res) - 2) & "]"n End Ifn Elsenn res = "" & arrn End Ifn n arrToStr = resnnEnd Functionn

上述代碼源自我的實踐項目。

6234456/Excel-VBA-Dictsgithub.com

利用Evaluate將字元串映射為相應函數，並注意空值以及字元串參數。

但是這種解決方式有明顯的弊端，即無法傳遞更加複雜的函數。但是通過操作VBE，將相關代碼進行一次「預編譯」後，可以實現與函數式的無縫對接。我正在編寫的xlPack項目就採用了這種新思路。

實戰教程重點跟大家介紹我所掌握的Excel VBA相關的黑科技，敬請期待。

本期問題: Excel中的MVC模式與模版引擎。

試實現下圖中的效果，要求樣式具有可擴展性。

<圖>

<本期的問題描述相對複雜。問題相關的工作表待上傳>

有任何問題請在下方留言。

本專欄所有文章著作權歸屬本人。未經本人書面許可，除知乎日報外，任何人不得轉載。

推薦閱讀：