Haber verici

[el-vis]

Ekli tabolda belirtilmiştir.Teşekkürler

 

[Ömer]

Merhaba,

Çalışma sayfasının kod bölümüne kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim deg, c As Range
 
    If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
    
    With Target
        If .Row < 3 Then Exit Sub
        If .Count > 1 Then Exit Sub
        If .Value = "" Then Exit Sub
    
        If WorksheetFunction.CountIf(Range("A3:A" & Rows.Count), .Value) > 1 Then
            MsgBox "Bu veri daha önce girilmiş"
            deg = .Value
            .ClearContents
            Set c = Range("A3:A" & Rows.Count).Find(deg, , xlValues, xlWhole)
            If Not c Is Nothing Then
                c.Select
            End If
        End If
    End With
 
End Sub

.

 

[el-vis]

Çok teşekkür ederim istediğim gibi olmuş.Yanlnız bir şry sormak istiyorum,tekrar rdilrn sayı girildiğinde
bana mesaj ile uyarı veriyor çok güzel.Tamam dediğimde beni tekrarlanan sayıya getiriyor.Bu da çok güzel.Fakat buna rağmen bu sayıyı yazmaya karar verirsem yazamıyorum.Yani tekrar sayısını otomatik olarak siliyor.Tekrar edileni yazmak yada yazmamak benim elimde olamaz mı? Teşekkür ederim emekleriniz için.Çok yararlı oldunuz...

 

[BAZGİRET]

Merhaba
Koddaki .ClearContents
satırını silerek deneyin.
kolay gelsin

 

[el-vis]

Çok teşekkür ederim tam istediğim gibi oldu.İnşallah bir gün sizin gibi problemlere çözüm bulabilecek duruma gelebiliriz.Sağolun...

 

[Ömer]

Tekrar edileni yazmak yada yazmamak benim elimde olamaz mı?

Kodları aşağıdakilerle değiştirin. Mesaj ile veri girişini onaya bağladım, ayrıca renklendirme ekledim.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Dim alan As Range, c As Range, Adr As String, renk
 
    Set alan = Range("A3:A" & Rows.Count)
 
    If Intersect(Target, alan) Is Nothing Then Exit Sub
 
    With Target
        If .Count > 1 Then Exit Sub
        If .Value = "" Then Exit Sub
 
        If WorksheetFunction.CountIf(alan, .Value) > 1 Then
            Set c = alan.Find(.Value, , xlValues, xlWhole)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    If c.Address <> .Address Then
                        renk = c.Interior.ColorIndex
                        c.Select
                        c.Interior.ColorIndex = 3
                        If MsgBox("Bu veri daha önce girilmiş" & Chr(10) & _
                            "Devam edeyim mi?", vbInformation + vbYesNo, "Bilgi") = vbYes Then
                            .Select
                            c.Interior.ColorIndex = renk
                            Exit Sub
                        Else
                            c.Interior.ColorIndex = renk
                            .ClearContents
                            .Select
                            Exit Sub
                        End If
                    End If
                    Set c = alan.FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End If
    End With
 
End Sub

 

[el-vis]

Çok teşekkür ederim,bunu sizden isteyecektim fakat fazla oluyorum diye düşünüp istememiştim.Çok teşekkürler.

 

[el-vis]

Gördüğüm kadarıyla bu konuda çok ileridesiniz.Affınıza sığınarak şunu da isteye bilirmiyim acaba.Diyelimki 4 kere benim isteğim ile yazılmış bir barkod , bir kez daha yazıldığında uyarı gelecek ve önceki tekrar kırmızıya boyanacak.Daha önce yazılanları da başka bir renk ile gösterebilir mi?