Mükerrer uygulaması yardım

[orkuncan5]

aşağıdaki değişik bir metodla yazılmış kırmızı boyalı olan mükerrer kayıdı engelleme kodunu

If WorksheetFunction.CountIf(.Range("B2.B65536"), CDbl(TextBox1.Text)) > 0 Then
MsgBox "Bu Kod nolu ürün daha önceen girilmiş."

aşağıdaki koda nasıl uyarlarız

Option Explicit

Private Sub CommandButton1_Click()
Sheets("Sayfa2").Select
Range("A2").Select
If Range("A2") = "" Then
ActiveCell = 1
ActiveCell.Offset(0, 1) = TextBox1.Text
ActiveCell.Offset(0, 2) = TextBox2.Text
ActiveCell.Offset(0, 3) = TextBox3.Text
ActiveCell.Offset(0, 4) = TextBox4.Text
Else
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveCell = ActiveCell.Offset(-1, 0) + 1
ActiveCell.Offset(0, 1) = TextBox1.Text
ActiveCell.Offset(0, 2) = TextBox2.Text
ActiveCell.Offset(0, 3) = TextBox3.Text
ActiveCell.Offset(0, 4) = TextBox4.Text
End If
End Sub

 

[Ömer]

Merhaba,

Bu haliyle işinize yaramayabilir. Sadece istediğiniz ilaveyi yaptım.

Sheets("Sayfa2").Select 
[COLOR=blue]If WorksheetFunction.CountIf(.Range("B2.B65536"), CDbl(TextBox1.Text)) > 0 Then[/COLOR]
[COLOR=blue]  MsgBox "Bu Kod nolu ürün daha önceen girilmiş."[/COLOR]
[COLOR=blue]  Exit Sub[/COLOR]
[COLOR=blue]Else[/COLOR]
    Range("A2").Select
    If Range("A2") = "" Then
    ActiveCell = 1
    ActiveCell.Offset(0, 1) = TextBox1.Text
    ActiveCell.Offset(0, 2) = TextBox2.Text
    ActiveCell.Offset(0, 3) = TextBox3.Text
    ActiveCell.Offset(0, 4) = TextBox4.Text
    Else
    Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
    ActiveCell = ActiveCell.Offset(-1, 0) + 1
    ActiveCell.Offset(0, 1) = TextBox1.Text
    ActiveCell.Offset(0, 2) = TextBox2.Text
    ActiveCell.Offset(0, 3) = TextBox3.Text
    ActiveCell.Offset(0, 4) = TextBox4.Text
    End If
[COLOR=blue]End If[/COLOR]

.

 

[orkuncan5]

Ömer Bey kodu aynen ekledim ama aynı isimlerle kayıt yapıyor,aynı isimle kayıt yapmayı engellemiyor.

 

[Ömer]

Açıklamasını yapmıştım. Eklediğiniz bölüm sayımı yapmıyor olabilir.

Küçük bir örnek ekleyerek açıklamanızı tavsiye ederim...

 

[orkuncan5]

Ömer Bey dosya ektedir.