Excel sayfasına şartlı kayıt

[seddur]

Merhaba.Aşağıdaki kod ile userformdan excel sayfasına kayıt yapıyorum Yapmak istediğim A sutununa yapılan kayıt bir önceki ile aynı ise I-J-K sütunlarına kayıt yapmasın farklı ise kayıt yapsın.Sayfa görüntüsünü fikir vermesi bakımından paylaşıyorum..Yardımcı olduğunuz için teşekkür ederim.

Private Sub CommandButton5_Click()
If Me.TextBox28 = "" Then MsgBox "İlaç Adı Giriniz": Me.TextBox28.SetFocus: Exit Sub
If Me.TextBox19 = "" Then MsgBox "Hasta Adı Giriniz": Me.TextBox28.SetFocus: Exit Sub
If Me.ListBox1.ListIndex = -1 Then MsgBox "İlaç zamanı seçiniz": Me.TextBox28.SetFocus: Exit Sub
If Me.ListBox2.ListIndex = -1 Then MsgBox "Doz belirtiniz": Me.TextBox28.SetFocus: Exit Sub

Dim Sayfam As Worksheet, Satır As Integer
Set Sayfam = Worksheets("Kayıt")
Satır = Sayfam.Range("A" & Rows.Count).End(3).Row + 1

Sayfam.Range("A" & Satır) = TextBox19
Sayfam.Range("B" & Satır) = TextBox2
Sayfam.Range("C" & Satır) = TextBox28
Sayfam.Range("D" & Satır).Offset(, Me.ListBox2.ListIndex) = Me.ListBox1.Text

Sayfam.Range("I" & Satır) = TextBox24
Sayfam.Range("J" & Satır) = TextBox25
Sayfam.Range("K" & Satır) = TextBox26


MsgBox "Kayıt Yapıldı"


End Sub

 

[Korhan Ayhan]

Merhaba,

Bu tür tekrarlı kayıtları önlemek için eğer tek kriteriniz varsa EĞERSAY yada CTRL+F (Find) ile, eğer birden fazla kriteriniz varsa ÇOKEĞERSAY ile sonuca gidebilirsiniz.

Siz "A" sütununa göre kontrol istemişsiniz. Set Sayfam ile başlayan satırın altına aşağıdaki sorguyu ekleyiniz.

If WorksheetFunction.CountIf(Sayfam.Range("A:A"), TextBox19) > 0 Then
    MsgBox "Bu kayıt daha önce girilmiştir!", vbCritical
    Exit Sub
End If

 

[Cengiz Demir]

@Korhan Ayhan üstad, yanlış anlamadıysam birden fazla kayıt olacak ama tc kimlik, cep telefonu ve ücret bilgisi sadece ilk kayıtta olacak.

@seddur hocam sürekli bir üstteki kayda göre kontrol yapılacaksa kodlama biraz daha basit olur. (Aşağıdaki gibi)
Ama ilk kayıttaki kişi örn. 10 satır sonra yeniden olacaksa; o zaman işler karışır.
Kodlamayı farklı yapmak gerekir. O tür bir kod için vakti ve benden daha bilgili olan bir üstad bakabilir sanırım. (Benim hem daha fala vaktimi alır hem de daha kısa kodlarla yapılabiliecek işi daha uzun kodlarla yapabilirim.)

Satır numarasını belirlediğiniz koddan aşağısını aşağıdaki kodlarla değiştirin.

tc = TextBox24
cep = TextBox25
ucr = TextBox26

kont = Sayfam.Range("A" & Satır - 1) & Sayfam.Range("B" & Satır-1)
kont2 = TextBox19 & TextBox2

    If kont = kont2 Then
        tc = ""
        cep = ""
        ucr = ""
    End If

Sayfam.Range("A" & Satır) = TextBox19
Sayfam.Range("B" & Satır) = TextBox2
Sayfam.Range("C" & Satır) = TextBox28
Sayfam.Range("D" & Satır).Offset(, Me.ListBox2.ListIndex) = Me.ListBox1.Text

Sayfam.Range("I" & Satır) = tc
Sayfam.Range("J" & Satır) = cep
Sayfam.Range("K" & Satır) = ucr

MsgBox "Kayıt Yapıldı"