mükerrer kaydı engelleme

[excelin kurdu]

Merhaba;

Dosyada birinci sayfaya kayıt alıp ikinci sayfaya tablo olarak kaydediyorum dosyayı. ama birinci sayfadaki kayıt tuşuna ikinci kez tıklayınca tekrar tablo alınan kayıt alıyor. Tekrarlayan kaydı yapmamasını ve birinci sayfada daha önce yapılan kayıt bulunuyor diye belirtmesini istiyorum. Bu konuda nasıl bir makro yazabilirim yardımcı olabilir misiniz?

 

[EmrExcel16]

Merhaba , önerim bu tür form kayıt durumlarında kayıt sonrasında kayıt formunun temizlenmesi , bunun için kaydet makronuzun sonuna aşağıdaki kodu eklemeniz.

Sayfa1.Range("C5:C13,C15:C16").ClearContents

Ama ben silmek istemiyorum ve aynı kayıtı da tekrarlamak istemiyorum derseniz aşağıdaki kodları deneyin , yada her ikisini de yapsın derseniz silmesi için verdiğim kodları da bu kodların sonuna ekleyebilirsiniz.

Sub Kaydet1()
 
    Dim Syf, sKyt, i
    Set Syf = Sayfa2
    sKyt = Syf.Cells(Rows.Count, 1).End(3).Row
    If [C5] = Syf.Cells(sKyt, 1) And [C6] = Syf.Cells(sKyt, 2) And [C7] = Syf.Cells(sKyt, 3) And [C8] = Syf.Cells(sKyt, 4) And _
       [C9] = Syf.Cells(sKyt, 5) And [C10] = Syf.Cells(sKyt, 6) And [C11] = Syf.Cells(sKyt, 7) Then
        MsgBox "Bu kayit son kayit ile ayni"
    Else
        For i = 1 To 12
            Syf.Cells(sKyt + 1, i).Value = Sayfa1.Cells(i + 4, 3)
        Next
    End If
 
End Sub

 

[YUSUF44]

Aşağıdaki kodla istediğiniz oluyor ama ÇOKEĞERSAY formülü boş hücreleri dikkate almadığı için Kayıt sayfanızda boş hücre olursa mükerrer olarak kabul etmiyor. Sorunu nasıl aşacağımı bulamadım:

Sub Kaydet()
    Application.ScreenUpdating = False
        Application.CutCopyMode = False
            Dim i As Integer
            If Sayfa2.Range("a2") = "" Then
                i = 2
            Else
                i = Sayfa2.Range("A1").End(xlDown).Row + 1
            End If
            If WorksheetFunction.CountIfs(Sayfa2.Range("A1:A" & i), Sayfa1.[C5], Sayfa2.Range("B1:B" & i), Sayfa1.[C6], Sayfa2.Range("C1:C" & i), Sayfa1.[C7], _
                                          Sayfa2.Range("D1:D" & i), Sayfa1.[C8], Sayfa2.Range("E1:E" & i), Sayfa1.[C9], Sayfa2.Range("F1:F" & i), Sayfa1.[C10], _
                                          Sayfa2.Range("G1:G" & i), Sayfa1.[C11], Sayfa2.Range("H1:H" & i), Sayfa1.[C12], Sayfa2.Range("I1:I" & i), Sayfa1.[C13], _
                                          Sayfa2.Range("J1:J" & i), Sayfa1.[C14], Sayfa2.Range("K1:K" & i), Sayfa1.[C15], Sayfa2.Range("L1:L" & i), Sayfa1.[C16]) > 0 Then
                sor = MsgBox("Bu kayıt daha önce Tabloya eklenmiştir!" & Chr(10) & "Tekrar eklensin mi?", vbYesNo)
                If sor = vbYes Then
                    GoTo 10
                Else
                    MsgBox "Mükerrer kayıt eklenmedi!", vbInformation
                    GoTo 20:
                End If
            End If
10:
            Sayfa1.[C5:C16].Copy: Sayfa2.Cells(i, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            MsgBox "Yeni kayıt tabloya aktarıldı!", vbInformation
20:
        Application.ScreenUpdating = True
    Application.CutCopyMode = True
    Sheets("Kayıt").Select
End Sub

 

[excelin kurdu]

çok teşekkür ederim desteğinize sağlık
ilk yaptığım sil işlemi işimi gördü. Birşey daha sorabilir miyim. Ben bu yaptığım dosyayı aynı şekilde e tablolara yapıp aynı makrolarla telefondan giriş sağlamak istiyorum. bunu yapabilir miyim?

 

[EmrExcel16]

Bildiğim kadarıyla makrolar e tablolar da çalışmıyordu , onların kendine has "script" kodları vardı. O yüzden de bu kodlar ile telefondan işlem yapmak pek mümkün gözükmüyor gibi.