Блог

Главная - Вопросы по программированию - Ошибки, возникающие при использовании пользовательских функций (VBA)

Ошибки, возникающие при использовании пользовательских функций (VBA)

#excel #vba #excel-2007

#excel #vba #excel-2007

Вопрос:

Я создал пользовательскую функцию в 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

Комментарии:

1. Это я или вы перезаписываете значение FIFO_PROFIT в конце? Это не выдаст ошибку, если вы ее перезапишете, не так ли? В таком случае просто добавьте a GoTo внутри каждого из ваших операторов If, который проверяет наличие ошибки, и отредактируйте код до конца функции.

2. @EvilBlueMonkey, да, вы правы, я перезаписывал, потому что думал, что это единственный способ, которым это будет работать. Позвольте мне проверить ваше решение и сообщить вам, сработало оно или нет. 1 для быстрого реагирования

3. @EvilBlueMonkey, как именно это будет работать? Если (условие) перейти к конечной функции????

4. rtfm , доступ к которому осуществляется нажатием клавиши F1, когда курсор находится на неизвестном вам методе (CVErr), но вы можете вызвать реальную ошибку! И используйте 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 инструкции здесь.

Опять же, вы также можете использовать 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