我有四张纸：
投资
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函数，从“TOTALS”表的all_totals列调用date1作为参数。这不起作用，我最好的猜测是这可能是由于“用户定义函数”的某些限制。
但是，正如您在下面看到的那样，我不会改变任何其他单元格值，只会改变调用函数的单元格。只是想知道是否有人有任何关于如何解决此问题的建议？
'========
'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@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
答案 0 :(得分：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