Question

我在访问范围内的单元格值时遇到了问题。

总体挑战相当复杂，但我似乎陷入了困境，所以欣赏思想。

Function LookupSum(criteriaRng As Range, criteriaHeadRng As Range, lookupColumn As String, DataTable As Range, Optional OffsetRow As Integer) As Integer
'Looks up multiple row values in a lookup column and returns the sum
'criteriaRng and criteriaHeadRng are equally sized horizontal one row high ranges
'Our data table has the criteria down the left column and the lookup header along the top row
'The aim is to sum the values in the correct column where the leftmost row value meets the multiple criteria. There may be multiple criteria entries in the table. Offset can be used to pick the first, second third row consistently. The data table is sorted on the criteria.

'Declarations
Dim criteria() As String, DataColumn As Integer, i As Integer, j As Integer
Dim FirstColumn As Range, TopRow As Range

'Initialise
LookupSum = 0 'default return
ReDim criteria(20) 'more than enough for this purpose


'First get the list of relevant criteria into the criteria() array
i = 0 'set our counters
j = 0
For i = 1 To criteriaRng.Cells.Count
    If criteriaRng(1, i).Value > 0 Then
        criteria(j) = criteriaHeadRng(1, i).Value2
        j = j + 1
    End If
Next

无法将任何内容读入标准（），从循环中掉出来，没有写入条件（）的点。没有错误，只是将cell.value显示为空时（我已经检查了地址）。

如果这是一个简单的错误，你可以在这里停止阅读并提供答案！

完整性的其余代码（我没有整理这个，因为我希望得到上述工作）

ReDim Preserve criteria(i) 'trim the array back to the useful data only

'Set up lookup columns in the data table - first row and first column
Set FirstColumn = Range("'" & DataTable.Worksheet.Name & "'!" & DataTable(1, 1).Address & ":" & DataTable(DataTable.Rows.Count, 1).Address)
Set TopRow = Range("'" & DataTable.Worksheet.Name & "'!" & DataTable(1, 1).Address & ":" & DataTable(1, DataTable.Columns.Count).Address)

'Find the column required in the data table. This gives us the column count
For Each d In TopRow.Cells
    DataColumn = DataColumn + 1 'loop through and increment the counter
    If Application.WorksheetFunction.IsError(d.Value2) Then If d.Value = lookupColumn Then Exit For 'exit when found. *Need to treat NA() as 0.*
Next d

'Now loop through the data table and retrieve the values to sum based on the required column and the criteria matching in the leftmost column.
l = 0
For k = 1 To i
    For Each e In FirstColumn.Cells
        l = l + 1
        dumb = e.Address
        If criteria(k) = e.Value2 Then
            If Application.WorksheetFunction.IsError(DataTable(l + OffsetRow, DateColumn).Value2) Then
             LookupSum = LookupSum + DataTable(l + OffsetRow, DateColumn).Value2
            End if
            Exit For
        End If
    Next e
Next k
end function

这个挑战的截图;目标是填充突出显示的区域：

非常感谢

Answer 1

以下代码似乎可以解决问题。看起来我正在把我和j混合在条件数组中。然后j = j + 1语句在标准中添加了一个额外的空白字段，这些字段抛出了结果。我通过循环到该部分中的j-1来检索索引值来反击这一点。

这种VBA方法相对于SUMIFS的主要优点是公式是可重复的，这是主要目标。每个单元格中的公式都要短得多。当然缺点是Excel的内置函数经过了很好的测试，并且在此代码中可能仍存在各种未经测试的边界条件或输入的错误。

最后需要注意的是，我仍然没有找到原始问题，原因是criteriaHeadRng(1, i).Value在原始代码中无效。当我做出这些改变时，似乎神秘地开始工作......

Function LookupSum(criteriaRng As Range, criteriaHeadRng As Range, lookupColumn As String, DataTable As Range, Optional OffsetRow As Integer)
    'Looks up multiple row values in a lookup column and returns the sum
    'criteriaRng and criteriaHeadRng are equally sized horizontal one row high ranges
    'Our data table has the criteria down the left column and the lookup header along the top row
    'The aim is to sum the values in the correct column where the leftmost row value meets the multiple criteria.

    'On Error GoTo ErrorHandler 'DEBUG code to catch errors

    'Declarations
    Dim criteria() As String, DataColumn As Integer, i As Integer, j As Integer, l As Integer
    Dim FirstColumn As Range, TopRow As Range, d As Range

    'Initialise
    'LookupSum = 0 'default return
    ReDim Preserve criteria(20) 'more than enough for this purpose

    'First get the list of relevant criteria into the criteria() array
    i = 0 'set our counters
    j = 0
    For i = 1 To criteriaRng.Cells.Count
        If criteriaRng(1, i).Value > 0 Then
            criteria(j) = criteriaHeadRng(1, i).Value
            j = j + 1
        End If
    Next

    ReDim Preserve criteria(j) 'trim the array back to the useful data only

    'Set up lookup columns in the data table - first row and first column
    Set FirstColumn = Range("'" & DataTable.Worksheet.Name & "'!" & DataTable(1, 1).Address & ":" & DataTable(DataTable.Rows.Count, 1).Address)
    Set TopRow = Range("'" & DataTable.Worksheet.Name & "'!" & DataTable(1, 1).Address & ":" & DataTable(1, DataTable.Columns.Count).Address)

    'Find the column required in the data table
    For Each d In TopRow.Cells
        dumb = d.Address
        DataColumn = DataColumn + 1 'loop through and increment the counter
        If Not Application.WorksheetFunction.IsError(d.Value2) Then If d.Text = lookupColumn Then Exit For 'exit when found
    Next d

    'Now loop through the data table and retrieve the indexed values
    For k = 0 To j - 1
        l = 0
        For Each e In FirstColumn.Cells
            l = l + 1
            dumb = e.Address
            If criteria(k) = e.Value2 Then
                If Not IsError(DataTable(l + OffsetRow, DataColumn).Value2) Then LookupSum = LookupSum + DataTable(l + OffsetRow, DataColumn).Value2
                Exit For
            End If
        Next e
    Next k

Exit Function
ErrorHandler: 'Debug code - comment/uncomment first line of function
    MsgBox Err.Number & vbCrLf & Err.Source & vbCrLf & Err.Description
    Stop
    Resume
End Function

感谢大家的评论。

无法访问范围中的单元格值（LookupSum函数）

1 个答案: