bzdww

Get answers and suggestions for various questions from here

Excel VBA combat (5) - functional programming

cms

On the code.

In the realm of the program, the only thing that can limit you is your imagination.

Functional programming combined with VBA provides unlimited possibilities for practical projects.


Option Explicit

Public Sub main()
' 测试 数组后两位为空值
   Dim i

   Dim arr(1 To 10)
   
   For i = 1 To 8
    arr(i) = 1
   Next i
   
' arrToStr 将数组转化为字符串,代码解析参考 基础教程部分
' 空值默认为 0, 下列模式可以计算净现值,折现率为10%
   Debug.Print arrToStr(map(arr, "_/1.1^{i}", , , False))
' 求出数组中字符串的长度之和
   Debug.Print arrToStr(reduce(Array("Qiou", "yang", "sgfxq"), "{v}+len(_)", 0, , , , , "", True))
' 取出各字符串左边两个字符
   Debug.Print arrToStr(map(Array("Qiou", "yang", "sgfxq"), "left(_, 2)", , , False, "", True))

End Sub

' 函数式之reduce
' arr 为目标数组
' operation 为函数的字符串表示
' initVal 为初始值 默认为0
' placeholder 为数组元素占位符 默认为_
' index 为对应索引占位符 默认为{i}
' cumVal 为初始值占位符 默认为{v}
' hasThousandSep 是否有欧洲版千位分隔符, 因为欧洲版Excel千位分隔符与国内小数点一样,会造成运行时错误,国内版Excel传否
' valNull 如果为空值时的替换值
' asStrParam 如果将数组元素以字符串形式传为参数
Private 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 Variant
    Dim k
    Dim v
    Dim tmp As String
    
    ' 如果为字符形式 则千位分隔符设定无意义
    If asStrParam Then
        hasThousandSep = False
    End If
    
    ' 如果有欧洲版千位分隔符 即"," 先将 "," 替换为 "."
    If hasThousandSep Then
        For k = LBound(arr) To UBound(arr)
           ' 先排除空值
            tmp = Replace(IIf(IsEmpty(arr(k)), valIfNull, arr(k)) & "", ",", ".")
            initVal = Replace(initVal & "", ",", ".")
           ' 将各元素进行相应替代 并求值
            initVal = Application.Evaluate(Replace(Replace(Replace(operation, placeholder, tmp), index, k), cumVal, initVal))
        Next k
    Else
        For k = LBound(arr) To UBound(arr)
            tmp = IIf(IsEmpty(arr(k)), valIfNull, arr(k))
            ' 为字符串形式的参数
            If asStrParam Then
                tmp = """" & tmp & """"
            End If
            ' 将各元素进行相应替代 并求值
            initVal = Application.Evaluate(Replace(Replace(Replace(operation, placeholder, tmp), index, k), cumVal, initVal))
        Next k
    End If

    reduce = initVal
End Function

' 函数式之map
' 各参数与reduce相同
' 原理与reduce类似
Private 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 Variant
    Dim k
    Dim v
    Dim tmp As String
    
    If asStrParam Then
        hasThousandSep = False
    End If
    
    If hasThousandSep Then
        For k = LBound(arr) To UBound(arr)
            tmp = Replace(IIf(IsEmpty(arr(k)), valIfNull, arr(k)) & "", ",", ".")
            arr(k) = Application.Evaluate(Replace(Replace(operation, placeholder, tmp), index, k))
        Next k
    Else
        For k = LBound(arr) To UBound(arr)
            
            tmp = IIf(IsEmpty(arr(k)), valIfNull, arr(k))
            
            If asStrParam Then
                tmp = """" & tmp & """"
            End If
            
            Debug.Print tmp
            
            arr(k) = Application.Evaluate(Replace(Replace(operation, placeholder, tmp), index, k))
        Next k
    End If

    map = arr
End Function

'将数组转换为字符串
'讲解请参见 基础教程部分
Private Function arrToStr(ByRef arr) As String

        Dim res As String

        Dim i

        If IsArray(arr) Then

            If UBound(arr) - LBound(arr) + 1 = 0 Then
                res = "[ ]"
            Else

                res = "["

                For i = LBound(arr) To UBound(arr)

                    res = res & arrToStr(arr(i)) & ", "
                Next i

                res = Left(res, Len(res) - 2) & "]"
            End If
        Else

            res = "" & arr
        End If
        
        arrToStr = res

End Function


The above code is derived from my practice project.

6234456/Excel-VBA-Dicts github.com


Use Evaluate to map strings to the corresponding functions, and pay attention to null values ​​and string parameters.


But this solution has the obvious drawback of not being able to pass more complex functions. However, by operating VBE and performing a "pre-compilation" of the relevant code, a seamless interface with the function can be realized. The xlPack project I am working on uses this new idea.


The actual combat tutorial focuses on introducing the black technology related to Excel VBA that I have mastered, so stay tuned.


This issue: The MVC pattern and template engine in Excel.

Try to achieve the effect in the image below, requiring styles to be extensible.

Employee information has the following fields

From top to bottom are name, age, gross salary, income tax rate, department, and employment month.

Above 7000 monthly for compliance.


The template can be defined as follows.


file download

qiou.eu/xl/Case5.xlsm qiou.eu


Please leave a message below if you have any questions.


All articles in this column are copyrighted by me. No one may reprint without the written permission of the person, except for the daily report.