personel puanları filtreleme ile ilgili yardım

[bllyldz]

Merhabalar sayın hocalarım,
Personelle ilgili ay içinde değişik tarihlerde girilmiş olan verileri.
ilk ve son tarihleri yazdıktan sonra her personeli 1 defa yazmak kaydıyla ay içindeki farklı tarihlerde almış olduğu puanların toplamını listeleyecek kod lazım.

Örnek dosya ekte sunulmuştur yardımlarınız için şimdiden teşekkür ederim.

İyi çalışmalar.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Private Sub CommandButton1_Click()
 
    Dim Sv As Worksheet, d As Object, i As Long, sat As Long, deg, a1, a2, s
 
    Set Sv = Sheets("veriler")
    Set d = CreateObject("Scripting.Dictionary")
 
    Range("F20:G" & Rows.Count).ClearContents
    If [G6] = "" Or [G7] = "" Then MsgBox "Tarih Girin": Exit Sub
 
    For i = 2 To Sv.Cells(Rows.Count, "B").End(xlUp).Row
        If Sv.Cells(i, "A") >= [G6] And Sv.Cells(i, "A") <= [G7] Then
            deg = Sv.Cells(i, "B")
            If Not d.exists(deg) Then
                s = Sv.Cells(i, "F")
                d.Add deg, s
            Else
                s = d.Item(deg)
                s = s + Sv.Cells(i, "F")
                d.Item(deg) = s
            End If
        End If
    Next i
 
    a1 = d.keys: a2 = d.items: sat = 20
    For i = 0 To d.Count - 1
        Cells(i + sat, "F") = a1(i)
        Cells(i + sat, "G") = CDbl(Format(a2(i), "#,##0.00"))
    Next i
 
End Sub

.

 

[bllyldz]

Süpersinnn Ömer hocam

Tam istediğim gibi olmuş eline emeğine sağlık.
Çok teşekkür ederim.İyi çalışmalar.