Aynı veride uyarı için

[abbasonline]

Girilmiş olan veriden önceden var ise uyarması için nasıl bir makro hazırlamamız gerekli.

 

[Korhan Ayhan]

Selamlar,

Örnek dosyanıza göre aşağıdaki kodu sayfanızın kod bölümüne uygulayıp denermisiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BUL As Range, ADRES As String
    
    If Intersect(Target, Range("C7:C65536,G7:G65536")) Is Nothing Then Exit Sub
    If Target = "" Then Exit Sub
    Set BUL = Range("C7:C" & Target.Row - 1).Find(Cells(Target.Row, "C"), LookAt:=xlWhole)
    If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            If Cells(BUL.Row, "G") = Cells(Target.Row, "G") Then
                MsgBox "Bu kayıt daha önce " & BUL.Row & " satırında girilmiştir !", vbCritical, "Dikkat !"
                Cells(Target.Row, "C") = ""
                Cells(Target.Row, "G") = ""
                Cells(Target.Row, "C").Select
                Exit Do
            End If
        Set BUL = Range("C7:C" & Target.Row - 1).FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
    End If
End Sub

 

[abbasonline]

Teşekkürler ellerinize sağlık.

 

[abbasonline]

Korhan bey vermiş olduğunuz kod üstteki örnek Excel sayfasında çok güzel çalışıyor, ancak ben sizin vermiş olduğunuz makroyu alttaki makro ile birlikte kullanacağımdan dolayı bendeki orjinal dosyada hata verdi nasıl düzenlemem gerekli.


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [E3:E65536]) Is Nothing Then Exit Sub
Set Aralık = Range("D3900065536")
Set BUL = Aralık.Find(Target, LookAt:=xlWhole)
If Not BUL Is Nothing Then
Application.EnableEvents = False
ADRES = BUL.Address
Do
Target.Offset(0, -1) = Cells(BUL.Row, "E")
Set BUL = Aralık.FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> ADRES
Application.EnableEvents = True
End If
End Sub

 

[Korhan Ayhan]

Selamlar,

Keşke bu bilgileri en başında açıklasaydınız. Aşağıdaki şekilde denermisiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ARALIK As Range, BUL As Range, ADRES As String
    
    If Intersect(Target, Range("C7:C65536,G7:G65536,E3:E65536")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If Target = "" Then Exit Sub
    If Target.Column = 3 Or Target.Column = 7 Then
        Set BUL = Range("C7:C" & Target.Row - 1).Find(Cells(Target.Row, "C"), LookAt:=xlWhole)
        If Not BUL Is Nothing Then
            ADRES = BUL.Address
            Do
                If Cells(BUL.Row, "G") = Cells(Target.Row, "G") Then
                    MsgBox "Bu kayıt daha önce " & BUL.Row & " satırında girilmiştir !", vbCritical, "Dikkat !"
                    Cells(Target.Row, "C") = ""
                    Cells(Target.Row, "G") = ""
                    Cells(Target.Row, "C").Select
                    Exit Do
                End If
            Set BUL = Range("C7:C" & Target.Row - 1).FindNext(BUL)
            Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        End If
 
    Else
    
        Set ARALIK = Range("D39000:D65536")
        Set BUL = ARALIK.Find(Target, LookAt:=xlWhole)
        If Not BUL Is Nothing Then
        Application.EnableEvents = False
        ADRES = BUL.Address
        Do
        Target.Offset(0, -1) = Cells(BUL.Row, "E")
        Set BUL = ARALIK.FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
        Application.EnableEvents = True
        End If
    End If
 
    Set ARALIK = Nothing
    Set BUL = Nothing
End Sub

 

[abbasonline]

Bu şekilde giriyorum kendimin önceki makrosunu komple silip sizin 5 mesajdaki makroyu yapıştırıyorum bizim önceki makro çalışmıyor sadece mükerrer kayıt olduğunda uyarıyor.

 

[abbasonline]

Korhan bey

makroları çalıştıramadım bir yerde hata var galiba, bu makrolar ile ilgili olan bir örnek dosya ekte, kolay gelsin.

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.

 

[abbasonline]

Korhan bey, Teşekkürler ellerinize sağlık.