sayfa1 de aynı veri varsa uyarı almak ?

[07 Osman]

Merhabalar,

Excel çalışma kitabımda 2009 ve 2010 olmak üzere iki sayfa var. 2009 sayfasında A1:A2000 aralığında tc numaralarından oluşan 2009 yılında kaydedilmiş veriler var. Ben 2010 yılında yine A1 hücresinden başlamak üzere (muhtemelen yine A1:A2000 aralığı yeterli olacak) aşağı doğru veri kaydetmeye devam edeceğim. İstediğim şu mesela A1 hücresine ilk tc numaramı kaydediyorum, eğer bu tc numarası 2009 sayfasındaki A1:A2000 aralığında varsa (daha önceden kayıt edilmiş ise) bir mesaj penceresi ile bu veri 2009 sayfasında şu sırada kayıtlıdır, eski kayıt olarak kaydedilecek desin, mesaj penceresindeki tamam tuşuna basılınca da veri kaydolsun ancak verinin sağ tarafındaki hücreye (B1), veya benim belirlediğim herhangi bir hücreye eski kayıt ibaresi yerleşsin. yeni kayıtların tamamında da sağ taraftaki hücrelere veya belirlediğim herhangi bir hücreye, herhangi bir uyarı olmaksızın yeni kayıt ibaresi yerleşsin.

İşlemi, bu şekilde yapıyoruz, diyelimki A50 hücresine geldim, ama diyelimki tc numarasını yazarken yanlışlıkla 2010 yılında kaydettiğim tc numaralarından birisini yazdım, bu sefer yine mesaj penceresi ile bu kayıt daha önceden kaydedilmiş tekrar kayıt yapamazsınız diye beni uyarsın.

Çok şey istediğimin farkındayım belki, ama resmi dairede çalışıyorum ve bu programa çok ihtiyacım var. yardım ederseniz çok sevinirim.

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz.


Kullanılan kod; (2010 isimli sayfanın kod bölümüne uygulayın.)

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BUL As Range
    
    On Error GoTo Son
    
    If Intersect(Target, Range("A2:A65536")) Is Nothing Then Exit Sub
    
    If Target <> "" Then
    
        Set BUL = Sheets("2010").Range("A1:A" & Target.Row - 1).Find(Target.Text)
        If Not BUL Is Nothing Then
            MsgBox "Bu kayıt bu sayfada " & BUL.Address & " hücresinde daha önceden kayıt edilmiştir !" & Chr(10) & _
            "Tekrar kayıt edemezsiniz !", vbCritical, "Dikkat !"
            Target = ""
            Target.Select
            GoTo Son
        End If
        
        Set BUL = Sheets("2009").Range("A:A").Find(Target.Text)
        If Not BUL Is Nothing Then
            MsgBox "Bu kayıt 2009 sayfasında " & BUL.Address & " hücresinde kayıtlıdır !" & Chr(10) & _
            "Eski kayıt olarak kayıt edilecektir.", vbCritical, "Dikkat !"
            Target.Next = "Eski Kayıt"
        Else
            Target.Next = "Yeni Kayıt"
        End If
    
    Else
    
        Target.Next = ""
    
    End If
    
Son:
    Set BUL = Nothing
End Sub

 

[BG]

Sayın Korhan Ayhan

Çok güzel bir çalışma olmuş elinize sağlık iyi çalışmalar dilerim.

 

[07 Osman]

Korhan bey ilginize çok teşekkür ederim. Tam istediğim şeyi yapmışsınız. Ancak benden kaynaklanan bir sorun nedeniyle işimi göremedim. Şöyleki ;

Bu işlemi bir memur arkadaşım için onun anlatımına göre istemiştim. Ancak dosyaya kendim bakma fırsatı bulduğum da verilerin daha önceden girilmiş olduklarını 2009 ve 2010 gördüm. Sizin gönderdiğiniz kodlarla birebir veri girişlerinde tam sizden istediğim gibi işliyor fakat, mevcut verilerin olduğu sayfaya sizin kodları yapıştırdığımda her bir hücre için yaklaşık (1300 tane imiş) imleci hücreye yerleştirip enter yapmam gerekiyor. İşte burada tıkandım. Umarım anlatabildim.

 

[Korhan Ayhan]

Selamlar,

Arkadaşınızın dosyasında veriler hangi satır ve sütunlarda bulunuyor belirtirseniz kodu ona göre revize edebilirim.

 

[07 Osman]

Dosyayı ekte gönderiyorum.

Not: Dosya tarafımdan kaldırılmıştır. Lütfen kişilerin gerçek bilgilerini forumda yayınlamayınız. (Korhan AYHAN)

 

[Korhan Ayhan]

Selamlar,

Dosyanızı gerçek veriler içerdiğini düşünerek ekten sildim. Bu konuya lütfen dikkat ediniz.

Aşağıdaki kodu deneyiniz.

Option Explicit
 
Sub MERNİS_NO_KONTROL()
    Dim X As Long
    
    For X = 3 To Range("E65536").End(3).Row
        If WorksheetFunction.CountIf(Range("A:A"), Cells(X, "E")) > 0 Then
            Cells(X, "I") = "2009 Kaydı Var"
        Else
            Cells(X, "I") = "Yeni Kayıt"
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub