Bir verinin kaçıncı defa girildiğini görmek

[pylor]

Değerli uzman arkadaşlar ekteki dosyam ile ilgili yardımcı olursanız memnun olurum yardımlarınızdan dolayı çok teşekkür ederim

 

[Ziynettin]

Merhaba,

....

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a(), X As Integer, Son As Integer, Say As Integer, Sut As Integer
Dim Yil_1 As Date, Yil_2, Deg_1, Deg_2

    On Error Resume Next

    If Target.Column = 6 Or Target.Column = 8 Or Target.Column = 11 Then
        Deg_1 = Year(Cells(Target.Row, 4))
        Deg_2 = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
        Son = Target.Row
        a = Range("D2:K" & Son)
        Sut = Target.Column - 3
            For X = 1 To UBound(a)
                Yil_1 = Year(a(X, 1))
                Yil_2 = UCase(Replace(Replace(a(X, Sut), "ı", "I"), "i", "İ"))
                    If Yil_1 = Deg_1 And Yil_2 = Deg_2 Then
                        Say = Say + 1
                    End If
            Next X
        If Say > 0 Then: Target.Offset(, 1) = Say
    End If
End Sub

http://s3.dosya.tc/server7/oo9cad/Ornek_pylor.xls.html

 

[Korhan Ayhan]

Aşağıdaki gibi deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("F:F,H:H,K:K")) Is Nothing Then Exit Sub 'lazım satır
        
    On Error Resume Next
    deg = UCase(Replace(Replace(Target.Value, "ı", "I"), "i", "İ"))
        
    formul_adres_1 = "D2:D" & Target.Row
    formul_adres_2 = "F2:F" & Target.Row
    formul_adres_3 = "H2:H" & Target.Row
    formul_adres_4 = "K2:K" & Target.Row
    formul1 = "=SUMPRODUCT((YEAR(" & formul_adres_1 & ")=YEAR(" & "D" & Target.Row & "))*(" & formul_adres_2 & "=" & Target.Address & "))"
    formul2 = "=SUMPRODUCT((YEAR(" & formul_adres_1 & ")=YEAR(" & "D" & Target.Row & "))*(" & formul_adres_3 & "=" & Target.Address & "))"
    formul3 = "=SUMPRODUCT((YEAR(" & formul_adres_1 & ")=YEAR(" & "D" & Target.Row & "))*(" & formul_adres_4 & "=" & Target.Address & "))"
    
    If deg > 0 Then
        Cells(Target.Row, "G") = Evaluate(formul1)
        Cells(Target.Row, "I") = Evaluate(formul2)
        Cells(Target.Row, "L") = Evaluate(formul3)
    End If
End Sub

 

[pylor]

Sayın tasmed cevap için teşekkürler kod sorunsuz çalıştı. Sayın Ayhan sizin kodlarda çalıştı fakat bir sorun var şöyleki F sütununa veri girildiğinde G sütununda değeri görülüyor fakat aynı anda I ve L sütunlarında sıfır değerini yazıyor. Sayın tasmed'in cevabı işimi gördü ancak benim öğrenebilmem amacı ile bir düzeltme yapmak isterseniz bu cevabıda görmek isterim teşekkürler iyi günler dilerim