VBA 用户定义函数 #VALUE 错误
Posted
技术标签:
【中文标题】VBA 用户定义函数 #VALUE 错误【英文标题】：VBA User Defined Function #VALUE error 【发布时间】：2017-08-27 12:52:43 【问题描述】：我有四张纸：
投资
sample row-1: ABC, INV_ID1
sample row-2: ABC, INV_ID2
sample row-3: XYZ, INV_ID3
sample row-4: XYZ, INV_ID4
返回-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
返回-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
总计
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 Corbett@***
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
【问题讨论】：
代码不完整：从您的实现中getUniqueOwnerList() 必须返回一个范围，并且其单元格必须只包含有效的行号（没有字符串、负数、0 或空单元格）。但是还有更多问题：确保在模块顶部使用Option Explicit 以消除基本问题，找到“Integer”的所有实例并将它们替换为“Long”。正确定义所有变量：Dim i,j as integer 行将 i 定义为 Variant，j 定义为 Integer，而您想要的是 Dim i As Long, j as Long。 returnsPerOwnerDateRange 也是如此。
完成上述操作后，在分配给范围时使用Set 关键字：returnsPerOwnerTotalDueRange = Sheets(RETURNS_PER_OWNER...) 行应为Set returnsPerOwnerTotalDueRange = Sheets(RETURNS_PER_OWNER...)，然后将returnsPerOwnerDateRange.Count 替换为returnsPerOwnerDateRange.CountLarge
感谢您的 cmets，所做的更改仍然是相同的结果。我没有包括 getUniqueOwnerList() 因为它似乎不是问题（该函数正在返回值，我正在进入循环）。我仍然无法解释为什么执行控制没有超出“设置范围”语句。 （PS：我在上面原始问题的末尾包含了包含您的 cmets 的代码）
PS2：只是为了强调对 getCurrentMonthTotalDue 的调用是从工作表单元格发出的（就像带有参数的公式）
【参考方案1】：
正如 Paul Bica 在评论中提到的，您是：
未按预期定义变量 - 即 returnsPerOwnerDateRange 和 i 都声明为 Variant。 （returnsPerOwnerDateRange 是 Variant 的事实是您的代码不会崩溃的原因
returnsPerOwnerDateRange = Sheets(RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i)).Range(RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST)
行，因为当前语句将 returnsPerOwnerDateRange 变成了一个二维 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
【讨论】：
感谢您的 cmets。您对“双”数据类型的观察是正确的，我将在最终迭代中进行更改。但是，我遇到的问题似乎更严重。执行控制命中第一个“设置返回...”语句并且不超出它。 （PS：请看原题中编辑后的完整代码） PS2：只是为了强调对 getCurrentMonthTotalDue 的调用是从工作表单元格发出的（就像带有参数的公式） 在Set returns... 语句的第一个上放置一个断点，并尝试调用该函数。当它停在该行时，在即时窗口中输入?RETURNS_PER_OWNER_SHEET_PREFIX & uniqueOwnerList(i) 并按回车键——这会显示您期望的工作表吗？该工作表是否有一个名为"RETURNS_PER_OWNER_INSTALLMENT_DATE_LIST" 的工作表范围的命名范围？ （我不确定为什么它现在会在这条线上崩溃，如果它之前在你将 returnsPerOwnerDateRange 定义为 Variant 时越过它，除非你的所有工作表都没有正确设置。）
不知道为什么，但今天又试了一次，它成功了。可能与我在虚拟机上运行它有关。不过，非常感谢您的帮助@YowE3K...以上是关于VBA 用户定义函数 #VALUE 错误的主要内容，如果未能解决你的问题，请参考以下文章