Dolu satıra göre formülü arttırma

[mkuru28]

Arkadaşlar tekrar merhaba
Ekli dosyada ayrıntılı bir şekilde anlattığım gibi bir çalışma sayfasında B4:B aralığına veri girdikçe aynı veri daha önce girilmişse mükerrer kayıtları görebilmek için A4 hücresinde yazan

=EĞER(EĞERSAY($B$3:B4;B4)>1;"Mükerrer kayıt";"")

formülünün en son dolu satıra kadar aşağıya doğru yazılmasını istiyorum. Bu işlem için elimde bir kod var ama küçük bir düzenlemeye ihtiyacım var. Örnek dosya ektedir.

Formül genişletme

 

[maliex]

Sub numara_ver()
sonsatir = Cells(Rows.Count, "B").End(xlUp).Row

Range("A5:A500").ClearContents
Range("A4").Select
Selection.Copy
Range("A5:A" & sonsatir).Select
Selection.PasteSpecial Paste:=xlPasteFormulas
Application.CutCopyMode = False
End Sub

 

[DoğanD]

Merhaba,

Alternatif olarak bu kodu da kullanabilirsiniz. Aşağıdaki kodu Sayfa1'in kod kısmına eklerseniz kod B sütununa her bilgi eklendiğinde tetiklenir. Butona olan ihtiyacınız da ortadan kalkacaktır.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, dd, ss As Integer
If Target.Column = 2 Then
ss = Cells(Rows.Count, "B").End(xlUp).Row
Range("A4:A500").ClearContents 
For i = 4 To ss
If WorksheetFunction.CountIf(Range("B4:B" & i), Cells(i, 2)) > 1 Then
Cells(i, 1) = "Mükerrer Kayıt"
End If
Next i
End If
End Sub

 

[mkuru28]

Teşekkür ederim arkadaşlar. Emeğinize sağlık