VBA Fonction définie par l'utilisateur erreur #VALUE

Question

J'ai quatre feuilles:

1. INVESTISSEMENTS

   sample row-1: ABC, INV_ID1  
   sample row-2: ABC, INV_ID2  
   sample row-3: XYZ, INV_ID3  
   sample row-4: XYZ, INV_ID4 
   

2. RETOURS-ABC

   sample row: date1, status_INV_ID_1, returns_INV_ID_1, 
         status_INV_ID_2, returns_INV_ID_2,  
         totalABC=returns_INV_ID_1+returns_INV_ID_2 
   

3. RETOURS-XYZ

   sample row: date1, status_INV_ID_3, returns_INV_ID_3, 
         status_INV_ID_4, returns_INV_ID_4, 
         totalXYZ=returns_INV_ID_3+returns_INV_ID_4 
   

4. TOTAUX

   sample row: date1, all_totals 
   

Je veux all_totals = totalABC + totalXYZ

Étant donné que le nombre de retours feuilles peuvent augmenter à l'avenir et je l'intention de fournir un filtrage basé sur le propriétaire (ABC/XYZ etc.), J'ai écrit la fonction vba suivante à appeler à partir de la colonne all_totals de la feuille "TOTALS" avec date1 comme paramètre. Cela ne fonctionne pas et ma meilleure estimation est que cela peut être dû à une limitation de "Fonction définie par l'utilisateur".

Cependant, comme vous pouvez le voir ci-dessous, je ne modifie aucune autre valeur de cellule, seulement celle de la cellule à partir de laquelle la fonction est appelée. Je me demande simplement si quelqu'un a des suggestions sur la façon de résoudre ce problème?

'======== 
'Returns the current month total due for ALL 
'Data is pulled from individual owner sheets 
Function getCurrentMonthTotalDue(theDate As Date) As Integer 
' theDate  - MANDATORY: Month for which data is needed 
' RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST - is a named range of all installment dates in the "RETURNS-XXX" sheets 
' RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST - is a named range of totals in the "RETURNS-XXX" sheets 

Dim uniqueOwnerList as Variant 
Dim returnsPerOwnerDateRange, returnsPerOwnerTotalDueRange as Range 
Dim i,j as integer 
Dim totalDue as Integer 

totalDue = 0 

uniqueOwnerList = getUniqueOwnerList 

for i = LBound(uniqueOwnerList, 1) To UBound(uniqueOwnerList, 1) 
    'Construct the ranges to refer 
    returnsPerOwnerDateRange  = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range(RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST)   
    returnsPerOwnerTotalDueRange = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range(RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST) '=====> CONTROL HITS THIS BREAKPOINT 

    for j = 1 to returnsPerOwnerDateRange.Count                       '=====> BUT DOES NOT HIT THIS ONE AND NO ERROR IS SHOWN 
    if (returnsPerOwnerDateRange(j).value = theDate) then 
     totalDue = totalDue + returnsPerOwnerTotalDueRange(j) 
    end if 
    next j 
next i 

'Return value 
getCurrentMonthTotalDue = totalDue 

End Function 

EDIT: Y compris le code complet pour fournir plus de contexte:

Option Explicit 

'GLOBALS 
'-------- 
'Header names 
Public Const COMMITTED_INVESTMENTS_OWNER_LIST    = "COMMITTED_INVESTMENTS_OWNER_LIST" 
Public Const COMMITTED_INVESTMENTS_TICKET_LIST    = "COMMITTED_INVESTMENTS_TICKET_LIST" 
Public Const COMMITTED_INVESTMENTS_ID_LIST     = "COMMITTED_INVESTMENTS_ID_LIST" 
Public Const COMMITTED_INVESTMENTS_SHEET_PREFIX    = "INVESTMENTS" 
Public Const RETURNS_PER_OWNER_SHEET_PREFIX     = "RETURNS-" 
Public Const RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST  = "RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST" 
Public Const RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST   = "RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST" 
Public Const RETURNS_PER_OWNER_INSTALLMENT_DATE_COLUMN_ID = 1 
Public Const RETURNS_PER_OWNER_FIRST_INVESTMENT_ID_COLUMN_ID = 2 


'UTILITY 
'------- 

'======== 
'Returns column number in the range containing the given header string 
'Input range is assumed to be a single row range 
Function getColumnNumber(theRange as Range, theColumnHeader as String) 
' theRange - MANDATORY: The range in which search is to be made 
' theColumnHeader - MANDATORY: The string to be searched 

Dim myRow As Range 
Dim myCell As Range 
Dim myColumn as long 

myColumn = -1 

for each myRow in theRange.rows 
for each myCell in myRow.Cells 
    myColumn = myColumn + 1 
    if myCell.Value = theColumnHeader then 
    getColumnNumber = myColumn 
    return 
    end if 
next myCell 
next myRow 
getColumnNumber = -1 
End Function 

'FUNCTIONALITY 
'------------- 

'======== 
'Returns a list of unique entries from a given range 
Function getUniqueListFromRange(theSourceRange as Range) 
'Code courtesy Jean-François Corbett@stackoverflow 
    Dim varIn As Variant 
    Dim varUnique As Variant 
    Dim iInRow As Long 
    Dim iUnique As Long 
    Dim nUnique As Long 
    Dim isUnique As Boolean 

    varIn = theSourceRange 
    ReDim varUnique(1 To UBound(varIn, 1) * UBound(varIn, 2)) 

    nUnique = 0 
    For iInRow = LBound(varIn, 1) To UBound(varIn, 1) 

      isUnique = True 
      For iUnique = 1 To nUnique 
       If varIn(iInRow, 1) = varUnique(iUnique) Then 
        isUnique = False 
        Exit For 
       End If 
      Next iUnique 

      If isUnique = True Then 
       nUnique = nUnique + 1 
       varUnique(nUnique) = varIn(iInRow, 1) 
      End If 

    Next iInRow 
    '// varUnique now contains only the unique values. 
    '// Trim off the empty elements: 
    ReDim Preserve varUnique(1 To nUnique) 

    getUniqueListFromRange = varUnique 
End Function 

'======== 
Function getUniqueOwnerList() 
Dim myRange As Range 

Set myRange = Sheets("INVESTMENTS").Range("COMMITTED_INVESTMENTS_OWNER_LIST") 

getUniqueOwnerList = getUniqueListFromRange(myRange) 
End Function 

'======== 
Function getUniqueTicketList() 
Dim myRange As Range 

Set myRange = Sheets("INVESTMENTS").Range("COMMITTED_INVESTMENTS_TICKET_LIST") 

getUniqueTicketList = getUniqueListFromRange(myRange) 
End Function 

'======== 
Function getUniqueInvestmentIDList() 
Dim myRange As Range 

Set myRange = Sheets("INVESTMENTS").Range("COMMITTED_INVESTMENTS_ID_LIST") 

getUniqueInvestmentIDList = getUniqueListFromRange(myRange) 
End Function 

'======== 
Function isItemPresentinList(theItem as String, theList as Variant) as Boolean 
Dim i as long 
isItemPresentinList = False 

for i=LBound(theList, 1) To UBound(theList, 1) 
if (theList(i) = theItem) then 
    isItemPresentinList = True 
    return 
end if 
next i 

End Function 

'======== 
Function getColumnID(theColumnHeader as String, theHeaderRange as Range) as long 
Dim columnIndex as long 
Dim myCell as Range 

columnIndex = 0 
getColumnID = 0 

for each myCell in theHeaderRange 
    columnIndex = columnIndex + 1 
    if myCell.Value = theColumnHeader then 
    getColumnID = columnIndex 
    return 
    end if 
next myCell 

End Function 

'======== 
Function getInvestmentIDIndex(theInvestmentID as String) as long 
Dim theIndex as long 

theIndex = 0 
'If provided SVR-1, will return 1 
theIndex = Instr(theInvestmentID,"-") 

if theIndex = 0 then 
    theIndex = -1 
else 
    theIndex = theIndex + 1 
end if 

getInvestmentIDIndex = theIndex 

End Function 

'======== 
Function getAllInvestmentIDForOwner (theOwner as String) as Variant 
Dim i as long 
Dim j as long 
Dim theInvestmentOwnerRange as Range 
Dim theInvestmentIDRange as Range 
Dim theInvestmentList as Variant 

j = 0 
ReDim theInvestmentList(1 To UBound(theInvestmentIDRange, 1) * UBound(theInvestmentIDRange, 2)) 

Set theInvestmentOwnerRange = Sheets(COMMITTED_INVESTMENTS_SHEET_PREFIX).Range("COMMITTED_INVESTMENTS_OWNER_LIST") 
Set theInvestmentIDRange = Sheets(COMMITTED_INVESTMENTS_SHEET_PREFIX).Range("COMMITTED_INVESTMENTS_ID_LIST") 

for i = LBound(theInvestmentOwnerRange, 1) To UBound(theInvestmentOwnerRange, 1) 
    if (theInvestmentOwnerRange(i) = theOwner) then 
    j = j + 1 
    theInvestmentList(j) = theInvestmentIDRange(i) 
    end if 
next i 

ReDim Preserve theInvestmentList(1 to j) 

getAllInvestmentIDForOwner = theInvestmentList 

End Function 

'======== 
Function getAllInvestmentIDForTicket (theTicketID as String) as Variant 
Dim i as long 
Dim j as long 
Dim theInvestmentOwnerRange as Range 
Dim theInvestmentTicketRange as Range 
Dim theInvestmentList as Variant 

j = 0 
ReDim theInvestmentList(1 To UBound(theInvestmentIDRange, 1) * UBound(theInvestmentIDRange, 2)) 

Set theInvestmentOwnerRange = Sheets(COMMITTED_INVESTMENTS_SHEET_PREFIX).Range("COMMITTED_INVESTMENTS_OWNER_LIST") 
Set theInvestmentTicketRange = Sheets(COMMITTED_INVESTMENTS_SHEET_PREFIX).Range("COMMITTED_INVESTMENTS_TICKET_LIST") 

for i = LBound(theInvestmentTicketRange, 1) To UBound(theInvestmentTicketRange, 1) 
    if (theInvestmentTicketRange(i) = theTicketID) then 
    j = j + 1 
    theInvestmentList(j) = theInvestmentIDRange(i) 
    end if 
next i 

ReDim Preserve theInvestmentList(1 to j) 

getAllInvestmentIDForTicket = theInvestmentList 

End Function 

'======== 
Function getTicketForInvestmentID (theInvestmentID as String) as String 
Dim i as long 
Dim j as long 
Dim theInvestmentIDRange as Range 
Dim theInvestmentTicketRange as Range 

Set theInvestmentIDRange = Sheets(COMMITTED_INVESTMENTS_SHEET_PREFIX).Range("COMMITTED_INVESTMENTS_ID_LIST") 
Set theInvestmentTicketRange = Sheets(COMMITTED_INVESTMENTS_SHEET_PREFIX).Range("COMMITTED_INVESTMENTS_TICKET_LIST") 

for i = LBound(theInvestmentIDRange, 1) To UBound(theInvestmentIDRange, 1) 
    if (theInvestmentIDRange(i) = theInvestmentID) then 
    getTicketForInvestmentID = theInvestmentTicketRange(i) 
    return 
    end if 
next i 

getTicketForInvestmentID = "" 

End Function 

'======== 
'Returns the current month total due for ALL 
'Data is pulled from individual owner sheets 
Function getCurrentMonthTotalDue(theDate As Date) 
' theDate  - MANDATORY: Month for which data is needed 

Dim uniqueOwnerList as Variant 
Dim returnsPerOwnerDateRange as Range 
Dim returnsPerOwnerTotalDueRange as Range 
Dim i as long 
Dim j as long 
Dim totalDue as long 

totalDue = 0 

uniqueOwnerList = getUniqueOwnerList 

for i = LBound(uniqueOwnerList, 1) To UBound(uniqueOwnerList, 1) 
    'Construct the ranges to refer 
    Set returnsPerOwnerDateRange  = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range("RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST") 
    Set returnsPerOwnerTotalDueRange = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range("RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST") 

    for j = 1 to returnsPerOwnerDateRange.CountLarge 
    if (returnsPerOwnerDateRange(j).value = theDate) then 
     totalDue = totalDue + returnsPerOwnerTotalDueRange(j) 
    end if 
    next j 
next i 

'Return value 
getCurrentMonthTotalDue = totalDue 

End Function 

'======== 
'Returns the current month due for the specified parameters 
'Data is pulled from individual owner sheets with name matching the template 'RETURNS-XXX' 
Function getCurrentMonthDue(theDateRow As long, theOwnerList As Variant, theTicketList As Variant, theInvestmentList As Variant) 
' theDateRow  - MANDATORY: RowID of Month for which data is needed 
' theOwnerList  - MANDATORY: List of Owner names for which data is needed 
' theTicketList  - MANDATORY: List of Ticket IDs for which data is needed 
' theInvestmentList - MANDATORY: List of Investment IDs for which data is needed 

Dim uniqueOwnerList as Variant 
Dim allInvestmentsList as Variant 
Dim returnsPerOwnerDataRange as Range 
Dim i as long 
Dim j as long 
Dim theColumnID as long 

theColumnID = 0 
uniqueOwnerList = getUniqueOwnerList 

'FIRST: Loop through all owners mentioned in the filter value 
for i = LBound(theOwnerList, 1) To UBound(theOwnerList, 1) 
    'SECOND: Loop through all investments for the specific owner from the filter values provided 
    allInvestmentsList = getAllInvestmentIDForOwner(CStr(theOwnerList(i))) 
    for j = LBound(allInvestmentsList, 1) To UBound(allInvestmentsList, 1) 
     'THIRD: Check if the ticketID and investmentID match the filter values provided 
     if isItemPresentinList(getTicketForInvestmentID(Cstr(allInvestmentsList(j))),theTicketList) AND isItemPresentinList(CStr(allInvestmentsList(j)),theInvestmentList) then 
     'Construct the ranges to refer 
     Set returnsPerOwnerDataRange  = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & theOwnerList(i)).Range("RETURNS_PER_OWNER_DATA_RANGE") 

     'return the correct due amount 
     theColumnID = RETURNS_PER_OWNER_FIRST_INVESTMENT_ID_COLUMN_ID*getInvestmentIDIndex(CStr(theInvestmentList(j))) 
     getCurrentMonthDue = returnsPerOwnerDataRange (theDateRow)(theColumnID) 
     return 
     end if 
    next j 
next i 

'Return value 
getCurrentMonthDue = 0 

End Function 

'======== 
Function getFilteredList(theShape as Shape) 
Dim i As Long 
Dim selectedCount As Long 
Dim filteredList As Variant 

selectedCount = 0 

With theShape 
    ReDim filteredList(1 To .ListCount) 

    For i = 1 To .ListCount 
     If .Selected(i) Then 
      selectedCount = selectedCount + 1 
      filteredList(selectedCount) = .List(i) 
     End If 
    Next i 

    ' Trim off the empty elements: 
    ReDim Preserve filteredList(1 To selectedCount) 

End With 

getFilteredList = filteredList 

end function 

'======== 
Function getOwnerFilteredList 
getOwnerFilteredList = getFilteredList(Sheets("CONSOLIDATED SUMMARY").ListBoxes("List Box 8")) 
End function 

'======== 
Function getTicketFilteredList 
getTicketFilteredList = getFilteredList(Sheets("CONSOLIDATED SUMMARY").ListBoxes("List Box 9")) 
End function 

'======== 
Function getInvestmentIDFilteredList 
getInvestmentIDFilteredList = getFilteredList(Sheets("CONSOLIDATED SUMMARY").ListBoxes("List Box 10")) 
End function 

Answer 1

Comme Paul Bica mentionne dans un commentaire, vous êtes:

• ne pas définir vos variables que vous attendez - c'est-à-dire returnsPerOwnerDateRange et i sont tous deux déclarés Variant. (Le fait que returnsPerOwnerDateRange est un Variant est la raison pour laquelle votre code ne tombe pas en panne sur la déclaration

  returnsPerOwnerDateRange  = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range(RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST) 
  

  ligne

  , parce que le courant fait returnsPerOwnerDateRange dans un tableau 2 dimensions Variant contenant les valeurs de la gamme.)

• N'utilise pas Set pour affecter des références à des objets tels que des plages.

• Ne pas entourer les noms de plage dans les guillemets doubles pour les rendre littéraux. (Comme il était, ils étaient interprétées comme des variables, comme je suppose que votre RETURNS_PER_OWNER_SHEET_PREFIX est.)

Le code suivant fonctionnera probablement:

'======== 
'Returns the current month total due for ALL 
'Data is pulled from individual owner sheets 
Function getCurrentMonthTotalDue(theDate As Date) As Long ' Should this be Double? 
    ' theDate  - MANDATORY: Month for which data is needed 
    ' RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST - is a named range of all installment dates in the "RETURNS-XXX" sheets 
    ' RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST - is a named range of totals in the "RETURNS-XXX" sheets 

    Dim uniqueOwnerList As Variant 
    Dim returnsPerOwnerDateRange As Range, returnsPerOwnerTotalDueRange As Range 
    Dim i As Long, j As Long 
    Dim totalDue As Long ' Should this be Double? 

    totalDue = 0 

    uniqueOwnerList = getUniqueOwnerList 

    For i = LBound(uniqueOwnerList, 1) To UBound(uniqueOwnerList, 1) 
     'Construct the ranges to refer 
     'Assumes that "RETURNS_PER_OWNER_SHEET_PREFIX" is a global constant 
     Set returnsPerOwnerDateRange  = Worksheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range("RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST")   
     Set returnsPerOwnerTotalDueRange = Worksheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range("RETURNS_PER_OWNER_TOTAL_DUE_THIS_MONTH_LIST") 

     For j = 1 To returnsPerOwnerDateRange.Cells.Count 
      'NOTE: Referencing the cells within a range using a single index, 
      '  rather than a row and column index is a dangerous habit to get into, 
      '  but will work if the range is a single row or a single column. 
      If returnsPerOwnerDateRange(j).Value = theDate Then 
       totalDue = totalDue + returnsPerOwnerTotalDueRange(j).Value 
      End If 
     Next j 
    Next i 

    'Return value 
    getCurrentMonthTotalDue = totalDue 

End Function