Mükerrer Kayıt Engelleme

[hbgny]

Merhaba,
Userform ile daha yeni yeni işlem yapmaya başladım. Aşağıdaki formülle excele veri aktarıyorum. Ama istiyorum ki eğer A kolonunda daha önce aynı kod var ise kayıt yapmasın, uyarı versin. Bu koda nasıl bir ekleme yapmam gerekir? Yardımcı olabilir misiniz?

Private Sub UserForm_Initialize()

Dim x As Long
For x = 2 To 1000000

If Sheets("StokKartı").Range("A" & x).Value = "" Then Exit For
Next
LstStokListesi.ColumnCount = 9
LstStokListesi.RowSource = "StokKartı!A2:I" & x - 1


End Sub

 

[Korhan Ayhan]

İnceleyiniz.

Mükerrer Kayıt Uygulamaları

Bu başlıkta, bir veritabanında veya listede mükerrer kayıtların tespiti, ayıklanması gibi konuları içeren uygulamaları bulabilirsiniz.

www.excel.web.tr

 

[hbgny]

İnceleyiniz.

Mükerrer Kayıt Uygulamaları

Bu başlıkta, bir veritabanında veya listede mükerrer kayıtların tespiti, ayıklanması gibi konuları içeren uygulamaları bulabilirsiniz.

www.excel.web.tr

İlginize teşekkür ederim.
Az önce yanlış formülü kopyalayıp atmışım. Şimdi gönderdiğim formüle, sizin tavsiye ettiğiniz linkleri inceleyip, kırmızıya boyadığım formülü ekledim. Ama çalışmadı. Daha yeni yeni kod yazmaya başladığım için işin içinden çıkamadım. Yardımcı olabilir misiniz?


Private Sub BtnKaydet_Click()
Dim x As Long
Dim sor As Byte

If TxtStokKodu.Value = "" Or Not IsNumeric(TxtStokAlışFiyatı.Value) Or Not IsNumeric(TxtStokSatışFiyatı.Value) Then
MsgBox "Lütfen girmiş olduğunuz bilgileri kontrol ediniz..."
Exit Sub
End If
sor = MsgBox("Stok Kaydedilsin mi?", vbDefaultButton1 + vbQuestion + vbYesNo, "KAYDET")
If sor = 7 Then Exit Sub
For x = 2 To 1000000000
If WorksheetFunction.CountIf(Sheets("StokKartı").Range("A:A" & x), TxtStokKodu.Value) > 0 Then
MsgBox "Bu numara daha önce kaydedilmiş", vbCritical
Exit Sub
End If
If Sheets("stokkartı").Range("a" & x).Value = "" Then Exit For
Next
Sheets("stokkartı").Range("a" & x).Value = UCase(TxtStokKodu.Value)
Sheets("stokkartı").Range("b" & x).Value = UCase(TxtStokAçıklaması.Value)
Sheets("stokkartı").Range("c" & x).Value = UCase(TxtStokGrupKodu.Value)
Sheets("stokkartı").Range("d" & x).Value = UCase(TxtStokAltGrupKodu.Value)
Sheets("stokkartı").Range("e" & x).Value = UCase(TxtStokBarkodu.Value)
Sheets("stokkartı").Range("f" & x).Value = UCase(TxtStokAlışFiyatı.Value)
Sheets("stokkartı").Range("g" & x).Value = UCase(TxtStokSatışFiyatı.Value)
Sheets("stokkartı").Range("h" & x).Value = UCase(CbxBirimi.Value)
Sheets("stokkartı").Range("ı" & x).Value = UCase(CbxKdvOranı.Value)
BtnVazgeç_Click
FrmMesaj.LblMesaj.Caption = "Stok Kaydedildi..."
FrmMesaj.Show
End Sub

 

[YUSUF44]

If WorksheetFunction.CountIf(Sheets("StokKartı").Range("A1:A" & x), TxtStokKodu.Value) > 0 Then

 

[hbgny]

Oldu. İlginize çok teşekkür ederim.

 

[Asri]

Alternatif;
Ben aşağıdaki şekilde kullanıyorum. Seçimleri ihtiyaç kadar arttırabilirsiniz.

'Kullanımı
if varmi("STK001","C") then
   msgbox ("Ürün bulundu")
end if

Function varmi(bilgi, secim) As Long   
    If secim = "A" Then Set sayfak = sheets("Firmalar").Range("A:A").Find(bilgi, , xlValues, xlWhole)
    If secim = "B" Then Set sayfak = sheets("Hareketler").Range("B:B").Find(bilgi, , xlValues, xlWhole)
    If secim = "C" Then Set sayfak = sheets("Urunler").Range("C:C").Find(bilgi, , xlValues, xlWhole)
    
    If Not sayfak Is Nothing Then
       varmi = sayfak.Row
       Exit Function
    End If
    varmi = 0
End Function