使用用户定义函数 (VBA) 引发错误

Posted

技术标签:

【中文标题】使用用户定义函数 (VBA) 引发错误【英文标题】：Raising errors with User Defined Functions (VBA) 【发布时间】：2021-01-13 03:07:46 【问题描述】：

我在 vba 中创建了一个用户定义的函数来根据先进先出库存系统计算利润。在转到实际代码之前，我想检查一下天气输入是否有效。

'---------------Check Information for errors----------------------
    SellSum = Application.WorksheetFunction.Sum(SellQuantity)
    BuySum = Application.WorksheetFunction.Sum(BuyQuantity)
    
    
    SellPCount = Application.WorksheetFunction.Count(SellPrice)
    SellQCount = Application.WorksheetFunction.Count(SellQuantity)
    BuyPCount = Application.WorksheetFunction.Count(BuyPrice)
    BuyQCount = Application.WorksheetFunction.Count(BuyQuantity)

    
    If SellSum > BuySum Then                                        'More sales than inventory, throw error
        FIFO_PROFIT = VBA.CVErr(XlCVError.xlErrValue)
    End If
    
    If (BuyPCount <> BuyQCount Or SellPCount <> SellQCount) Then    'Incomplete data, throw error
        FIFO_PROFIT = VBA.CVErr(XlCVError.xlErrValue)
    End If
'-----------------------------------------------------------------

而在真正的代码之后，我就有了最终的价值，

FIFO_PROFIT = RunningProfit

但是，当我输入无效数据时，应该会引发错误，但它什么也没做。就像它只是跳过错误检查并跳转到实际代码。

实际代码有点长，我不相信它与它有任何关系。但如果有人想评论它， https://pastebin.com/fA2pY52f

【问题讨论】：

是我还是你最后覆盖了 FIFO_PROFIT 值？如果您覆盖它，它不会作为错误出现，对吗？在这种情况下，只需在每个 If 语句中添加一个 GoTo 来检查错误并将代码改写到函数的末尾。 @EvilBlueMonkey，是的，你是对的，我正在覆盖，因为我认为这是唯一可行的方法。让我检查您的解决方案，如果它有效与否，请与您联系。 +1 快速响应 @EvilBlueMonkey，这将如何运作？ if(condition) goto End Function ???? rtfm ，当光标在你不知道的方法上时按 F1 键访问（CVErr），但你可以Raise 一个真正的错误！并使用Option Explicit! 【参考方案1】：

我想说这样的事情可能会奏效：

Function FIFO_PROFIT(SellPrice As Variant, SellQuantity As Variant, BuyPrice As Variant, BuyQuantity As Variant) As Variant
'Calculate the Profit according to the FIFO method
 
 
'---------------Check Information for errors----------------------
    SellSum = Application.WorksheetFunction.Sum(SellQuantity)
    BuySum = Application.WorksheetFunction.Sum(BuyQuantity)
    
    
    SellPCount = Application.WorksheetFunction.Count(SellPrice)
    SellQCount = Application.WorksheetFunction.Count(SellQuantity)
    BuyPCount = Application.WorksheetFunction.Count(BuyPrice)
    BuyQCount = Application.WorksheetFunction.Count(BuyQuantity)
 
    
    If SellSum > BuySum Then                                        'More sales than inventory, throw error
        FIFO_PROFIT = VBA.CVErr(XlCVError.xlErrValue)
        
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
        GoTo FIFO_PROFIT_IS_ERROR '<--------------------ADDED CODE (1 of 3)X
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
        
    End If
    
    If (BuyPCount <> BuyQCount Or SellPCount <> SellQCount) Then    'Incomplete data, throw error
        FIFO_PROFIT = VBA.CVErr(XlCVError.xlErrValue)
        
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
        GoTo FIFO_PROFIT_IS_ERROR '<--------------------ADDED CODE (2 of 3)X
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    End If
'-----------------------------------------------------------------
 
'--------------MoreVariables--------------------------------------
Dim RunningSale As Variant
Dim RunningBuy As Variant
Dim RunningCost As Variant
Dim RunningBuyQuantity As Variant
Dim RunningSales As Variant
Dim RunningProfit As Variant
Dim Residual As Variant
Dim UsedupResidual As Variant
Dim y As Variant
 
y = 1
RunningCost = 0
Residual = 0
UsedupResidual = 0
RunningSales = 0
RunningProfit = 0
'-----------------------------------------------------------------
 
 
    For x = 1 To SellQCount
    
    If y <> 1 Then                                                                  'BUGtest
    
        RunningBuyQuantity = Residual + BuyQuantity(y).Value2
    End If
            While (RunningBuyQuantity <= SellQuantity(x).Value2 And y <= BuyQCount) 'Bugtest
                    
                If y = 1 Then
                    RunningCost = RunningCost + (BuyPrice(y).Value2 * BuyQuantity(y).Value2)
                Else
                    RunningCost = RunningCost + ((BuyPrice(y).Value2 * BuyQuantity(y).Value2) + (BuyPrice(y - 1).Value2 * Residual))
                End If
                
                Residual = 0
                RunningBuyQuantity = RunningBuyQuantity + BuyQuantity(y).Value2
                y = y + 1
                
            Wend
        
        If RunningBuyQuantity > SellQuantity(x).Value2 Then
            Residual = SellQuantity(x).Value2 - RunningBuyQuantity
            UsedupResidual = BuyQuantity(y).Value2 - Residual
            RunningCost = RunningCost + (UsedupResidual * BuyPrice(y).Value2)
        End If
        
        RunningSales = SellPrice(x).Value2 * SellQuantity(x).Value2
        
        RunningProfit = RunningProfit + RunningSales - RunningCost
        
        RunningSales = 0
        RunningCost = 0
        
    Next x
    
    FIFO_PROFIT = RunningProfit
    
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
FIFO_PROFIT_IS_ERROR:     '<--------------------ADDED CODE (3 of 3) X
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    
End Function

我已经使用了你的整个函数并添加了 3 行代码。我没有检查代码本身，所以没有对其进行评估。在这两种情况下（更多的销售和不完整的数据），FIFO_PROFIT 已正确设置，然后GoTo 指令将代码发送到 FIFO_PROFIT_IS_ERROR 行，方便地放置在函数的末尾。有关GoTo 指令here 的更多信息。

再一次，您也可以使用Exit Function 指令。它不需要第三行 FIFO_PROFIT_IS_ERROR，它也可以工作。这将导致：

Function FIFO_PROFIT(SellPrice As Variant, SellQuantity As Variant, BuyPrice As Variant, BuyQuantity As Variant) As Variant
'Calculate the Profit according to the FIFO method
 
 
'---------------Check Information for errors----------------------
    SellSum = Application.WorksheetFunction.Sum(SellQuantity)
    BuySum = Application.WorksheetFunction.Sum(BuyQuantity)
    
    
    SellPCount = Application.WorksheetFunction.Count(SellPrice)
    SellQCount = Application.WorksheetFunction.Count(SellQuantity)
    BuyPCount = Application.WorksheetFunction.Count(BuyPrice)
    BuyQCount = Application.WorksheetFunction.Count(BuyQuantity)
 
    
    If SellSum > BuySum Then                                        'More sales than inventory, throw error
        FIFO_PROFIT = VBA.CVErr(XlCVError.xlErrValue)
        
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
        Exit Function '<--------------------ADDED CODE (1 of 2)X
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
        
    End If
    
    If (BuyPCount <> BuyQCount Or SellPCount <> SellQCount) Then    'Incomplete data, throw error
        FIFO_PROFIT = VBA.CVErr(XlCVError.xlErrValue)
        
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
        Exit Function '<--------------------ADDED CODE (1 of 2)X
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
        
    End If
'-----------------------------------------------------------------
 
'--------------MoreVariables--------------------------------------
Dim RunningSale As Variant
Dim RunningBuy As Variant
Dim RunningCost As Variant
Dim RunningBuyQuantity As Variant
Dim RunningSales As Variant
Dim RunningProfit As Variant
Dim Residual As Variant
Dim UsedupResidual As Variant
Dim y As Variant
 
y = 1
RunningCost = 0
Residual = 0
UsedupResidual = 0
RunningSales = 0
RunningProfit = 0
'-----------------------------------------------------------------
 
 
    For x = 1 To SellQCount
    
    If y <> 1 Then                                                                  'BUGtest
    
        RunningBuyQuantity = Residual + BuyQuantity(y).Value2
    End If
            While (RunningBuyQuantity <= SellQuantity(x).Value2 And y <= BuyQCount) 'Bugtest
                    
                If y = 1 Then
                    RunningCost = RunningCost + (BuyPrice(y).Value2 * BuyQuantity(y).Value2)
                Else
                    RunningCost = RunningCost + ((BuyPrice(y).Value2 * BuyQuantity(y).Value2) + (BuyPrice(y - 1).Value2 * Residual))
                End If
                
                Residual = 0
                RunningBuyQuantity = RunningBuyQuantity + BuyQuantity(y).Value2
                y = y + 1
                
            Wend
        
        If RunningBuyQuantity > SellQuantity(x).Value2 Then
            Residual = SellQuantity(x).Value2 - RunningBuyQuantity
            UsedupResidual = BuyQuantity(y).Value2 - Residual
            RunningCost = RunningCost + (UsedupResidual * BuyPrice(y).Value2)
        End If
        
        RunningSales = SellPrice(x).Value2 * SellQuantity(x).Value2
        
        RunningProfit = RunningProfit + RunningSales - RunningCost
        
        RunningSales = 0
        RunningCost = 0
        
    Next x
    
    FIFO_PROFIT = RunningProfit
    
End Function

【讨论】：

以上是关于使用用户定义函数 (VBA) 引发错误的主要内容，如果未能解决你的问题，请参考以下文章

VBA 用户定义函数 #VALUE 错误

用户定义的函数在 vba 中工作正常，而从显示“值”错误的 excel 表调用时

尝试调用外部 VBA 函数时，只能强制在公共对象模块中定义的用户定义类型

在 VBA 中执行 ADO 记录集命令会引发错误“转换 nvarchar 值时转换失败”

将单元格值提取到 SQL 查询中时 VBA 引发错误

自定义 VBA 函数引发意外输出 [重复]