仅汇总过滤/可见数据 VBA

Question

我有一个 VBA 脚本， 由另一位成员非常友好地提供。

自从请求帮助后，我意识到我只需要像 SUBTOTAL 函数那样对可见单元格中的数据求和（例如，如果应用了过滤器）。 我曾尝试插入xlCellTypeVisible但运气不佳（仍然是 VBA 的新手！）。 这个宏背后的上下文可以通过阅读上面链接中的线程找到。

任何人都可以帮助提供正确的代码吗？

 Function maxUniqueWithThresholda(ids As Range, vals As Range, _
                                 dates As Range, thold As Long)
     Static d As Object, i As Long

     'create a dictionary for unique ids only if not previously created
     If d Is Nothing Then Set d = CreateObject("scripting.dictionary")
     d.RemoveAll

     'limit the processing ranges
     Set ids = Intersect(ids, ids.Parent.UsedRange)
     Set vals = vals.Resize(ids.Rows.Count, ids.Columns.Count)
     Set dates = dates.Resize(ids.Rows.Count, ids.Columns.Count)

     'cycle through the processing ranges
     For i = 1 To ids.Cells.Count
         'is date within threshold?
         If dates.Cells(i) <= thold And xlCellTypeVisible Then
             'collect the maximum value for each unique id into dictionary Items
             d.Item(ids.Cells(i).Value2) = _
               Application.Max(d.Item(ids.Cells(i).Value2), vals.Cells(i).Value2)
         End If
     Next i

     maxUniqueWithThresholda = Application.Sum(d.items)

 End Function

非常感谢您提前提供帮助

Answer 1

感谢 Michal 和用户 10735198 的输入：

Function maxUniqueWithThresholda(ids As Range, vals As Range, _
                            dates As Range, thold As Long)
Static d As Object, i As Long

'create a dictionary for unique ids only if not previously created
If d Is Nothing Then Set d = CreateObject("scripting.dictionary")
d.RemoveAll

'limit the processing ranges
Set ids = Intersect(ids, ids.Parent.UsedRange)
Set vals = vals.Resize(ids.Rows.Count, ids.Columns.Count)
Set dates = dates.Resize(ids.Rows.Count, ids.Columns.Count)

'cycle through the processing ranges
For i = 1 To ids.Cells.Count
    'is date within threshold?
    If dates.Cells(i) <= thold And dates.Cells(i).EntireRow.Hidden = False Then
        'collect the maximum value for each unique id into dictionary Items
        d.Item(ids.Cells(i).Value2) = _
          Application.Max(d.Item(ids.Cells(i).Value2), vals.Cells(i).Value2)
    End If
Next i

maxUniqueWithThresholda = Application.Sum(d.items)

End Function