vba - 在 VBA 中执行此功能是否有更聪明的方法？

Question

    Public Function Test(x As String) As String
    
    Dim Convert As Integer
    Dim Search01 As Integer
    Dim Search02 As Integer
    Dim Search03 As Integer
    Dim Search04 As Integer
    Dim Search05 As Integer
    Dim Search06 As Integer
    Dim Search07 As Integer
    Dim Search08 As Integer
    Dim Search09 As Integer
    Dim Search10 As Integer
    Dim Search11 As Integer
    Dim Search12 As Integer
    Dim Search13 As Integer
    Dim Search14 As Integer
    Dim Search15 As Integer
    Dim Search16 As Integer
    Dim Search17 As Integer
    Dim Search18 As Integer
    Dim Search19 As Integer
    Dim Search20 As Integer
    
    Search01 = InStr(1, x, "OBCI¥¯ENIE Podatek") 
    Search02 = InStr(1, x, "Op³ata miesiêczna za kartê od") 
    Search03 = InStr(1, x, "Op³ata za prowadzenie rachunku od")
    Search04 = InStr(1, x, "Op³ata za transakcje od") 'YES
    Search05 = InStr(1, x, "PROWIZJA ZA PRZEWALUTOW") 'YES
    Search06 = InStr(1, x, "UZNANIE Odsetki od salda dodatniego") 
    Search07 = InStr(1, x, "Za wyp³atê gotówki z bankomatu")
    Search08 = InStr(1, x, "V. SOL") 
    Search09 = InStr(1, x, "DOP. VISA")
    Search10 = InStr(1, x, "za wyp³atê z bankomatu") 
    Search11 = InStr(1, x, "Prowizja za przewalutow")
    Search12 = InStr(1, x, "Sprawdzenie dostêpnych") 
    Search13 = InStr(1, x, "Za wyp³atê z bankomatu kraj")
    Search14 = InStr(1, x, "Op³ata za wznowienie karty") 
    Search15 = InStr(1, x, "Op³ata za przelew BlueCash") 
    Search16 = InStr(1, x, "Op³ata miesiêczna za kartê") 
    Search17 = InStr(1, x, "WYP")
    Search18 = InStr(1, x, "Op³. za przelew ELIXIR")
    Search19 = InStr(1, x, "Op³. za przelew na rach. banku - BZWBK24")
    Search20 = InStr(1, x, "Pobrane odsetki od salda ujemn")
    
    If Search01 = 1 Then Convert = 1
    If Search02 = 1 Then Convert = 2
    If Search03 = 1 Then Convert = 3
    If Search04 = 1 Then Convert = 4
    If Search05 = 1 Then Convert = 5
    If Search06 = 1 Then Convert = 6
    If Search07 = 1 Then Convert = 7
    If Search08 = 1 Then Convert = 8
    If Search09 = 1 Then Convert = 8
    If Search10 = 1 Then Convert = 7
    If Search11 = 1 Then Convert = 5
    If Search12 = 1 Then Convert = 9
    If Search13 = 1 Then Convert = 7
    If Search14 = 1 Then Convert = 10
    If Search15 = 1 Then Convert = 11
    If Search16 = 1 Then Convert = 12
    If Search17 = 1 Then Convert = 13
    If Search18 = 1 Then Convert = 14
    If Search19 = 1 Then Convert = 14
    If Search20 = 1 Then Convert = 15
    
Select Case Convert
        Case 1
            Test = "Bank-Charge Tax collected."
        Case 2
            Test = "Bank-Monthly fee for Debit card."
        Case 3
            Test = "Bank-Monthly Account maintenance fee."
        Case 4
            Test = "Bank-Monthly Fee for transactions."
        Case 5
            Test = "Bank-Commission for currencies conversion."
        Case 6
            Test = "Bank-Interest on the credit balance."
        Case 7
            Test = "Bank-Charge for withdrawing cash from ATM."
        Case 8
            Test = "Transactions Debit Card"
        Case 9
            Test = "Bank-Account Balance request"
        Case 10
            Test = "Bank-Debit Card Replacement fee"
        Case 11
            Test = "Bank-BlueCash electronic Tranfer"
        Case 12
            Test = "Bank-Monthly Debit Card Fee"
        Case 13
            Test = "Bank-Lodgement"
        Case 14
            Test = "Bank-Transaction charge for bill payments."
        Case 15
            Test = "Bank-Interest charged on the negative balance."
                
        Case Else
            Test = "Transactions Debit or Credit"
End Select
End Function

有没有更聪明的方法来编写这个函数？

标签： vba

Answer 1

此答案基于输入字符串“x”是 Instr 函数中使用的字符串之一。一个巧妙的解决方案是使用解耦字典。解耦字典使用两个字典。第一个将输入映射到代码，第二个使用代码返回一个值。解耦字典的优点是您没有重复的项目。下面的代码有点难看，因为它将两个字典保持在一个方法中，而不是将它们放在模块或全局级别。

Public Function Test(x As String) As String
    
    Static myInputSD As scripting.dictionary
    If myInputSD Is Nothing Then
    
        Set myInputSD = New scripting.dictionary
    
        With myInputSD
        
            .Add "OBCI¥¯ENIE Podatek", 1
            .Add "Op³ata miesiêczna za kartê od", 2
            .Add "Op³ata za prowadzenie rachunku od", 3
            .Add "Op³ata za transakcje od", 4
            .Add "PROWIZJA ZA PRZEWALUTOW", 5
            .Add "UZNANIE Odsetki od salda dodatniego", 6
            .Add "Za wyp³atê gotówki z bankomatu", 7
            .Add "V. SOL", 8
            .Add "DOP. VISA", 8
            .Add "za wyp³atê z bankomatu", 7
            .Add "Prowizja za przewalutow", 5
            .Add "Sprawdzenie dostêpnych", 9
            .Add "Za wyp³atê z bankomatu kraj", 7
            .Add "Op³ata za wznowienie karty", 10
            .Add "Op³ata za przelew BlueCash", 11
            .Add "Op³ata miesiêczna za kartê", 12
            .Add "WYP", 13
            .Add "Op³. za przelew ELIXIR", 14
            .Add "Op³. za przelew na rach. banku - BZWBK24", 14
            .Add "Pobrane odsetki od salda ujemn", 15
        
        End With
        
    End If
   
    
    Static myLookupSD As scripting.dictionary
    If myLookupSD Is Nothing Then
    
        Set myLookupSD = New scripting.dictionary
    
        With myLookupSD
        
            .Add 1, "Bank-Charge Tax collected."
            .Add 2, "Bank-Monthly fee for Debit card."
            .Add 3, "Bank-Monthly Account maintenance fee."
            .Add 4, "Bank-Monthly Fee for transactions."
            .Add 5, "Bank-Commission for currencies conversion."
            .Add 6, "Bank-Interest on the credit balance."
            .Add 7, "Bank-Charge for withdrawing cash from ATM."
            .Add 8, "Transactions Debit Card"
            .Add 9, "Bank-Account Balance request"
            .Add 10, "Bank-Debit Card Replacement fee"
            .Add 11, "Bank-BlueCash electronic Tranfer"
            .Add 12, "Bank-Monthly Debit Card Fee"
            .Add 13, "Bank-Lodgement"
            .Add 14, "Bank-Transaction charge for bill payments."
            .Add 15, "Bank-Interest charged on the negative balance."
            
        End With
        
     End If
     
     If myLookupSD.exists(myInputSD.Item(x)) Then
     
        Test = myLookupSD.Item(myInputSD.Item(x))
        
    Else
    
        Test = "Transactions Debit or Credit"
        
    End If
    
End Function

上面使用的脚本字典需要对 Microsoft 脚本运行时 (Tools.References) 的引用或将 'New Scripting.Dictionary' 替换为 'CreateObject("Scripting.Dictionary")'。

最后一个非常合理的替代方案是用集合或二维数组替换脚本字典。对于集合，您需要记住条目格式是 .add item,key 而不是 .key,item。对于数组，你必须处理所有那些丑陋的索引，所以如果你这样做的话，对你来说是正确的。