Question

我有一个非常友好的provided by another member 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

仅对已过滤/可见数据进行求和的VBA

1 个答案: