VBA用户定义函数#VALUE错误
我有四个片材:VBA用户定义函数#VALUE错误
-
投资
sample row-1: ABC, INV_ID1 sample row-2: ABC, INV_ID2 sample row-3: XYZ, INV_ID3 sample row-4: XYZ, INV_ID4
-
RETURNS-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
-
RETURNS-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
个
-
TOTALS
sample row: date1, all_totals
欲all_totals = totalABC + totalXYZ
由于返回片材可以在未来增加的数量和我打算提供基于所有者滤波(ABC/XYZ等),我写了以下vba函数,以date1作为参数的“TOTALS”表的all_totals列中调用。这是行不通的,我最好的猜测是这可能是由于“用户定义的功能”的一些限制。
但是,正如您在下面看到的,我没有更改任何其他单元格值,只是调用函数的单元格的值。只是想知道如果有人有任何建议如何解决这个问题?
'========
'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
编辑:包括完整的代码,以提供更多的背景:
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 [email protected]
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
正如保罗BICA提到了一个评论,你是:
-
没有定义的变量如您所愿 - 即
returnsPerOwnerDateRange
和i
都被声明为Variant
。 (事实上,returnsPerOwnerDateRange
是Variant
就是为什么你的代码不会对returnsPerOwnerDateRange = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range(RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST)
线崩溃的原因,因为目前语句使
returnsPerOwnerDateRange
到从范围内包含的值的2维数组Variant
)。 不使用
Set
来分配对象的引用,如范围。不使用双引号将范围名称括起来使其成为文字。 (因为它是,他们被解释变量,比如我假设你
RETURNS_PER_OWNER_SHEET_PREFIX
是。)
下面的代码可能会工作:
'========
'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
感谢您的评论。你对“Double”数据类型的观察是正确的,我将在最后的迭代中进行修改。但是,我所遇到的问题似乎更加严重。执行控制命中“Set returns ...”语句中的第一个,并且不会超出它。 (PS:请参阅原始问题中已编辑的完整代码) –
PS2:仅强调getCurrentMonthTotalDue的调用是由工作表单元格(如带参数的公式) –
在第一个“设置返回值”中放置一个断点。 ..'语句,并尝试调用该函数。当它停在线上时,在立即窗口中输入“?RETURNS_PER_OWNER_SHEET_PREFIX&uniqueOwnerList(i)'并按下回车键 - 是否显示您期望的表单?该工作表是否具有名为“RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST”'的工作表范围命名范围? (我不确定为什么现在它会在该行上崩溃,如果之前已经将'returnsPerOwnerDateRange'定义为'Variant'时才会越过它,除非没有正确设置所有表单。) – YowE3K
的代码是不完整的:从您的实现' getUniqueOwnerList()'必须返回一个范围,其单元格必须只包含有效的行号(无字符串,负数,0或空单元格)。但还有更多问题:确保在模块顶部使用Option Explicit来消除基本问题,找到所有“Integer”实例并用**“Long”**替换它们。正确地定义所有变量:当Dim i As Long,j Long时,行Dim i,j as integer定义i为Variant,j为Integer。 'returnsPerOwnerDateRange'相同。 –
完成上述操作后,在分配范围时使用'Set'关键字:'returnsPerOwnerTotalDueRange =表(RETURNS_PER_OWNER ...)'应为'Set returnsPerOwnerTotalDueRange =表(RETURNS_PER_OWNER ...)',然后替换'returnsPerOwnerDateRange。计数'与'returnsPerOwnerDateRange.CountLarge' –
Thx为您的意见,使更改仍然相同的结果。我没有包含getUniqueOwnerList(),因为它似乎不是问题(该函数正在返回值,我正在进入循环)。我仍然无法解释为什么执行控制不会超出“设置范围”语句。 (PS:我已经在上面的原始问题的末尾包含了代码,其中包含了您的意见) –