Найти среднее значение по данным в ячейке

Sub Тest()
    Dim Dt$()
    Dim Rw1&, Rw1F&, Rw1L&, Rw2&, Rw2F&, Rw2L&
    Dim D&, M&, Y&, i&
    Dim S#
    Dim ShP As Worksheet, ShV As Worksheet
    
    Set ShP = Sheets(1)     'Sheets("ПОИСК")
    Set ShV = Sheets(2)     'Sheets("ВЫРУЧКА")
    
    Rw1F = 2: Rw2F = 2
    Rw1L = ShP.Cells(Rows.Count, "A").End(xlUp).Row
    Rw2L = ShV.Cells(Rows.Count, "A").End(xlUp).Row
    
    For Rw1 = Rw1F To Rw1L
        Dt = Split(ShP.Cells(Rw1, "A"), ", ")
        For Rw2 = Rw2F To Rw2L
            D = Split(ShV.Cells(Rw2, "A"), ".")(0)
            M = Split(ShV.Cells(Rw2, "A"), ".")(1)
            Y = Split(ShV.Cells(Rw2, "A"), ".")(2)
            
            For i = LBound(Dt) To UBound(Dt)
                If D - Split(Dt(i), ".")(0) = 0 Then
                If M - Split(Dt(i), ".")(1) = 0 Then
                If Y - Split(Dt(i), ".")(2) = 0 Then
                    S = S + ShV.Cells(Rw2, "B")
                    Exit For
                End If
                End If
                End If
            Next i
        Next Rw2
        
        If S > 0 Then
            ShP.Cells(Rw1, "B") = _
                Round(S / (UBound(Dt) - LBound(Dt) + 1), 3)
            S = 0
        End If
    Next Rw1
End Sub