• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

C,D,E sütunlarına göre mükerrer kayıt kontrolü

Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
43,668
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Aşağıdaki kodlara C,D ve E sütunlarına göre mükerrer kayıt kontrolü eklemek istiyorum forumda araştırdım Sn. ALPEN'e ait aşağıdaki kodları buldum fakat kendi kodlarımda nereye ekleyeceğimi beceremedim.

Sn. ALPEN'e ait kodlar;

Private Sub CommandButton1_Click()
Dim x As Boolean
x = False
For i = 1 To Sheets("sheet2").Cells(65536, 1).End(xlUp).Row
If TextBox1.Text = Sheets("sheet2").Cells(i, 1) And TextBox2.Text = Sheets("sheet2").Cells(i, 2) Then
x = True
MsgBox ("Mükerrer kayıt")
Exit For
End If
Next i
If x = False Then
Sheets("sheet2").Cells(i, 1) = TextBox1
Sheets("sheet2").Cells(i, 2) = TextBox2
End If
End Sub

Kendi kodlarım;

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False

For X = 1 To 5
If Controls("TextBox" & X).Value = Empty Then
MsgBox ("Kayıt işlemi için gerekli tüm bölümlere veri girmelisiniz." _
& Chr(10) & "Lütfen boş bıraktığınız bölümleri doldurunuz."), vbExclamation, "Dikkat !"
Controls("TextBox" & X).SetFocus
Exit Sub
End If
Next

If ComboBox1.Value = Empty Then
MsgBox ("Kayıt işlemi için gerekli tüm bölümlere veri girmelisiniz." _
& Chr(10) & "Lütfen boş bıraktığınız bölümleri doldurunuz."), vbExclamation, "Dikkat !"
ComboBox1.SetFocus
Exit Sub
End If

If WorksheetFunction.CountA(Sheets("S1").[B2:B2501]) = 2500 Then
MsgBox ("En fazla 2.500 adet kayıt girebilirsiniz."), vbExclamation, "Dikkat !"
Call Formu_Temizle
Call UserForm_Initialize
Exit Sub
End If

Dim Tarih1, Tarih2, Tarih3 As Date
On Error Resume Next
Tarih1 = CDate((TextBox1 & "." & TextBox2 & "." & TextBox3))
Tarih2 = CDate(Sheets("S2").Range("B7"))
Tarih3 = CDate(Sheets("S2").Range("C7"))
If Tarih1 < Tarih2 Or Tarih1 > Tarih3 Then
MsgBox "Girdiğiniz tarih çalışma döneminizin dışında lütfen kontrol ediniz.", vbExclamation, "Dikkat !"
Call Formu_Temizle
Call UserForm_Initialize
Exit Sub
End If

If (CDbl(TextBox5.Value) + CDbl(Sheets("S3").Range("E10").Value)) > CDbl(Sheets("S3").Range("E7").Value) Then
MsgBox "Girmek istediğiniz belge ile Kümülatif Vergi Matrahınızı aşıyorsunuz." _
& Chr(10) & "Lütfen girdiğiniz tutarı kontrol ediniz.", vbExclamation, "Dikkat !"
Call Formu_Temizle
Call UserForm_Initialize
Exit Sub
End If

Sheets("S1").Select
Range("B2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
If Range("B2").Value = Empty Then
Range("B2").Value = 1
Range("B2").Select
Else
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value + 1
End If
ActiveCell.Offset(0, 1) = CDate((TextBox1.Value) & "." & (TextBox2.Value) & "." & (TextBox3.Value))
ActiveCell.Offset(0, 2) = TextBox4.Text
ActiveCell.Offset(0, 3) = ComboBox1.Text
ActiveCell.Offset(0, 4) = TextBox5.Value * 1
Range("C1:F2501").Sort Key1:=Range("C2"), Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("B2").Select
Call Formu_Temizle
Call UserForm_Initialize
Application.ScreenUpdating = True
End Sub
 
Selamlar,

Arkadaşlar bu konuda yardımlarınızı bekliyorum.
 
Bu şekilde yanıt vermek çok zor, bir örnek dosya eklermisiniz.
 
Selamlar,

Ã?rnek dosya ektedir.

Kayıt girerken Belge No, Tarih ve Firma Adına göre mükerrer kayıt kontrolü yapmak istiyorum.
 
Mukayese edilecek başlıklardan hiçbir zaman aynı olmayacak başlık sözkonusumudur, örneğin belge no her satırda farklımıdır.
 
Selamlar,

Diyelimki bir kayıt girdim bu kayıt aynı anda listboxa yükleniyor.Listboxtan ilgili kaydı seçtiğimde ve kayıt ekle butonuna tıkladığımda aynı kayıttan bir daha eklenebiliyor.Sonuç itibariyle hem listboxtan seçilince hemde yeni bir kayıt girerken aynı tarihte aynı belge nolu ve aynı firmaya ait giriş olmasını engellemek yani 3 kritere göre de mükerrer kayıt girişini engellemek istiyorum.
 
Mukayese edilecek başlıklardan hiçbir zaman aynı olmayacak başlık sözkonusumudur, örneğin belge no her satırda farklımıdır.
Genişletmek için tıkla ...

Sn COST_CONTROL

Ben sorunuzu tam olarak anlamış durumdayım. Belki yukarıdaki sorumu neden sorduğumu izah etmem gerekirdi. Eğer tablonuzdaki sütunlardan birinde (ki buna en uygunu belge no dur) kayıtlar tekrarsız ise yazılacak kod çok kolay olacak ve çok hızlı çalışacaktır. Aksi takdirde tüm satırların tek tek taranması gerekir ki buda çok fazla verisi olan bir tabloda kodun çalışma süresini çok uzatacaktır. Buna istinaden cevap verirseniz ona göre bir kod önereceğim.
 
Sn. leventm,

Maalesef 3 sütuna göre kıyaslama yapılması gerekiyor.Belki döngü uzun sürecek ama bu 3 sütununda kontrol edilmesi gerekiyor.
 
Sn. leventm,

Cevabınızı merakla bekliyorum.
 
Commandbutton2 ye aşağıdaki kodları ilave ettikten sonra alta kendi kodlarınızı ilave edebilirsiniz. Tüm satırları taratmadan farklı bir mantık düşündüm. Bu sebeple hızlı çalışan bir kod oldu.

[vb:1:cdd7d23382]Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Set s1 = Sheets("s1")
bul = 1
ara = TextBox4.Value
say = WorksheetFunction.CountIf(s1.[d2:d65536], ara)
If IsNumeric(ara) = True Then ara = TextBox4 * 1
If say > 0 Then
For b = 1 To say
adr = "d" & bul + 1 & ":d65536"
bul = WorksheetFunction.Match(ara, s1.Range(adr), 0) + bul
ara1 = s1.Cells(bul, "c")
ara2 = s1.Cells(bul, "e")
If ara1 = CDate((TextBox1 & "." & TextBox2 & "." & TextBox3)) And ara2 = ComboBox1 Then
MsgBox "BU KAYIT DAHA Ã?NCEDEN " & bul & " NOLU SATIRDA MEVCUTTUR"
Exit Sub
End If
Next
End If
.
.
.KENDİ KODLARINIZ
.
End Sub
[/vb:1:cdd7d23382]
 
Sn. leventm,

Cevabınız için çok teşekkür ederim fakat şöyle bir problem var.Listboxtan herhangi bir kaydı seçip kayıt ekle butonuna bastığımda kod gayet güzel çalışıyor.Fakat listboxtan bir kaydı seçip firma adını veya belge nosunu değiştirip kayıt ekle dediğimde yine uyarı mesajını alıyorum.Bu sıkıntıyıda halledebilirsek çok şık bir çözüm olacak.

(Bu arada sizeden cevap beklerken forumda araştırma yapıyordum sizin daha önce cevapladığınız bir sorudan faydalanarak istediğimi gerçekleştirdim.)
 
Haklısınız, yukarıdaki kodu yeniledim. Yenilenen yer kırmızı ile gösterilmiştir. Bu şekilde deneyin.
 
Teşekkür ederim. :arkadas:
 
Sn. leventm,

Kodlarda ufak bir sıkıntı daha tesbit ettim şöyleki firma adını rakamsal bir değer girip kayıt ekle diyorum daha sonra bu kaydı listboxtan seçip kayıt ekle dediğimde beni uyarması gerekirken uyarmıyor. Ama firma adı kısmına harf girdiğimde uyarı veriyor bunu nasıl halledebiliriz.

Ayrıca bu kodları kayıt bul için nasıl kullanabilirim aynı kodları Kayıt Bul butonuna atayıp tıkladığımda Listboxtan ilgili kaydı seçtirmek istiyorum.

:arkadas:
 
:hey: :hey: :yardim:
 
Kodu aşağıdaki ile değiştirerek deneyin.

[vb:1:d81cd054d3]Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
Set s1 = Sheets("s1")
bul = 1
ara = TextBox4.Value
say = WorksheetFunction.CountIf(s1.[d2:d65536], ara)
If IsNumeric(ara) = True Then ara = TextBox4 * 1
If say > 0 Then
For b = 1 To say
adr = "d" & bul + 1 & ":d65536"
bul = WorksheetFunction.Match(ara, s1.Range(adr), 0) + bul
ara1 = s1.Cells(bul, "c")
ara2 = s1.Cells(bul, "e")
deg = ComboBox1
If IsNumeric(ComboBox1) = True Then deg = ComboBox1 * 1
If ara1 = CDate((TextBox1 & "." & TextBox2 & "." & TextBox3)) And ara2 = deg Then
MsgBox "BU KAYIT DAHA Ã?NCEDEN " & bul & " NOLU SATIRDA MEVCUTTUR"
Exit Sub
End If
Next
End If
.
.
.
End Sub[/vb:1:d81cd054d3]

Bul butonunda ne yapmak istediğinizide biraz daha açarmısınız.
 
Selamlar,

Kod için teşekkür ederim. Bul butonunda yapmak istediğim işlem faturaları girerken kayıt sayısı arttığında elimdeki faturayı girip girmediğimi kolayca tesbit edebilmek. Faturaları girerken belli bir sıralama kullanmıyorum. Bunun için aynı kodu kullanabilirim diye düşündüm kodda sadece kayıtı bulup listboxta seçili hale getir demek gerekiyor. Tabi listboxtaki kayıt sayısı fazla olduğundan kayıtı bulup seçtiğinde kayıt ekranda kullanıcının görebileceği şekilde seçilmeli. Yani kayıt listenin alt sıralarındaysa bul dediğimde ekranda listede seçili ve görünür durumda olması gerekiyor.
 
:hey: :hey: :yardim:
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst