使用用户定义函数引发错误 (VBA)
Raising errors with User Defined Functions (VBA)
我在 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
我想说这样的东西可能有用：
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 中创建了一个用户定义函数来根据先进先出库存系统计算利润。在转到实际代码之前，我想检查一下输入是否有效。
'---------------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
我想说这样的东西可能有用：
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