如果我没理解错的话…

Sub test()
Dim rg As Range, rgU As Range, dt As Date
Dim arr: Dim el: Dim c As Range: Dim oSum as Integer

'set the range of date in column B - change if needed
With Sheet3
Set rg = .Range("B1", .Range("B1").End(xlDown))
End With

'date input
dt = "1-apr-23"

Set arr = CreateObject("scripting.dictionary")

For Each cell In rg
If Format(dt, "mmm-yy") = Format(cell.Value, "mmm-yy") Then
    If rgU Is Nothing Then Set rgU = cell Else Set rgU = Union(rgU, cell)
    arr.Item(cell.Offset(0, 2).Value) = 1
End If
Next

For Each el In arr
oSum = 0
    With rgU.Offset(0, 2)
        Set c = .Find(el)
        fa = c.Address
            Do
                If Not c Is Nothing Then oSum = oSum + c.Offset(0, 1).Value
                Set c = .FindNext(c)
            Loop Until c.Address = fa
    End With
MsgBox el & " : " & oSum
Next

End Sub

它将rg设置为列D中的日期范围。
作为dt变量的输入必须是一个日期，包括日期、月份和年份。
然后循环到每个单元格，并比较格式为“mmm-yy”的dt是否与格式为“mmm-yy”的循环单元格相同。如果相同，则将循环单元格收集到rgU变量中，并基于循环单元格创建唯一项。offset（0，2）。
当循环完成时，arr在rgU.offset（0，2）中的列D中有一个唯一的值。因此，它循环到arr中的每个el，使用find/findnext方法在rgU.offset（0，2）中获得el的总和。