僅匯總過濾/可見數據 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