Eğersay formülünün kodunu istiyorum...

[blackmonkey]

Ekli örnekte de belirtildiği gibi eğersay formülünü uygulayabiliyorum.. Fakat kod ile olması daha iyi. Bir de A sütununa veri girdiğimde (enter'ladığımda) "makro çalıştır" yapmadan kod kendiliğinden işlemeli ... Kolay gelsin...

 

[Necdet]

Merhaba,

Sub Benzer_Say()
Sheets("Sayfa1").Select
Range("D2:E65536").ClearContents
SonSatır = [A65536].End(3).Row
Son = [B65536].End(3).Row
For i = 2 To Son
    Cells(i, "D") = Application.WorksheetFunction.CountIf(Range("A2:A" & SonSatır), Cells(i, "B"))
    Cells(i, "E") = Application.WorksheetFunction.CountIf(Range("A2:A" & SonSatır), Cells(i, "C"))
Next i
MsgBox "bitti......"
End Sub

 

[AS3434]

Gönderdiğiniz dosyanın Sayfa1 in Kod Sayfasına

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [a:a]) Is Nothing Then Exit Sub
[D2:E13].ClearContents
For i = 2 To 13
Cells(i, 4) = WorksheetFunction.CountIf([a:a], Cells(i, 2))
Cells(i, 5) = WorksheetFunction.CountIf([a:a], Cells(i, 3))
Next
End Sub

Yazın.

 

[blackmonkey]

Hızla yanıtladınız, teşekkürler.. Gecikmeli karşılık için özür dilerim.. İşten ayrılmak zorunda kaldım.. Evden yazıyorum..
Sayın Necdet_Yesertener macronuz oldu ve çalıştı. Yalnız ben "makro çalıştır" yapmadan etkin sayfada veri girme işi bitince kendi otomatik yapsın istiyordum.
Sayın AS3434 sizin kodu çalıştıramadım.. Örneğe uygulayıp eklerseniz nerede yanlış yaptığımı görebilirim.

İlginize şimdiden saygılar.

 

[AS3434]

Ekli örnekte de belirtildiği gibi eğersay formülünü uygulayabiliyorum.. Fakat kod ile olması daha iyi. Bir de A sütununa veri girdiğimde (enter'ladığımda) "makro çalıştır" yapmadan kod kendiliğinden işlemeli ... Kolay gelsin...

Yazdığım makronun, Sayın Necdet Yesertener'in yazdığı ile bir farkı yok.
Sadece veri girdikçe kendini yeniler, butonsuz yani.

Dosyayı inceleyin. Sadece A sütununa veri girince çalışır. A sütununa veri girin veya düzeltin.

 

[Necdet]

Evet Sayın AS3434 ile benim kodlarım aynı, çünkü işlem aynı.
Sizin dediğiniz gibi Sayın AS3434 otomatik çalışır olarak yapmış.

Benden de istiyorsanız eğer, bende biraz parametrik yapayım dedim, yani B ve C sütunları aynı uzunlukta olmayabilir.

Dosya ekte.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Son = [A65536].End(3).Row
SonB = [B65536].End(3).Row
SonC = [C65536].End(3).Row
If SonB <= SonC Then
   j = SonC
Else
   j = SonB
End If
Range("D2:E" & j).ClearContents
For i = 2 To j
Cells(i, "D") = WorksheetFunction.CountIf(Range("A2:A" & Son), Cells(i, "B"))
Cells(i, "E") = WorksheetFunction.CountIf(Range("A2:A" & Son), Cells(i, "C"))
Next
Son:
End Sub

 

[blackmonkey]

Her iki Hocam'a da bir konu hakkındaki aydınlatıcı ve karşılaştırmalı bilgilerihden dolayı teşekkür ederim.. Öğretici olmuştur. Teşekkürlerimle... Saygılar...