aynı veri girildiginde uyar

[GRANDfather]

s.a arkadaslar benim bir tablom var bir cok isim girmem gerekiyor copy paste yoluyla isimleri giriyorum yalnız aynı isimleri tekrar girme olasılığımı kaldırmak icin örnek A12 hücresine AHMET MERT ismini kopyala yapıstır yaptım daha önce bunu yaptığımı hatırlamayarak A80 hücresine AHMET MERT ismini kopyala yapıstır yapmak istedigimde excel in beni uyarmasını istiyorum ofis 2007 kullanıcısıyım sizlerden bu konuda yardım bekliyor calışmalarınızda başarılar diliyorum.

 

[GRANDfather]

arkadaslar yokmu bu konuda bana yardımcı olacak birisi

 

[ozgretmen]

Dosya ekte...

 

[GRANDfather]

özöğretmen sorumla ilgilendigin icin cok teskkürler yalnız ben sanırım konuyu acıklarken eksik acıklamısım aynı veriyi girdigimde beni uyarsın ama veriyi yeniden yazıp yazıp yazmama hakkını bana bırakmasını istiyorum
örnek: AHMET MERT İsmini daha önce girdiniz yeniden girmek istediginize eminmisiniz yeniden girmek istiyarsanız evet istemiyorsanız hayır ı tıklayın gibi.

 

[GRANDfather]

arkadaslar bu dosya bana cok lazım bu konuda yardımcı olacak kimse yok mu acaba

 

[faylis]

bu hazırladığınız dosya benimde işme yarar çok teşekkür edirim bunun formülünü görmeye çalıştım göremedim başka dosaya uygulamak için...

 

[alicanxy58]

cevap

Private Sub Worksheet_Change(ByVal Target As Range)
Static veri()
Static Say As Integer
Dim Sorgu As String
If Target.Address = "$B$5" Then
Application.EnableEvents = False
On Error Resume Next
If IsError(Application.Match(Target.Value, veri, 0)) Then
On Error GoTo 0
Say = Say + 1
ReDim Preserve veri(1 To Say)
veri(Say) = Target.Value
Else:
Sorgu = MsgBox("Bu veriyi daha önce kullandınız." & vbCrLf & "Devam etmek istiyormusunuz?", vbCritical + vbYesNo, "Mükerrer Kayıt")
If Sorgu = vbNo Then Target.Value = Empty
End If
End If
Application.EnableEvents = True
End Sub

 

[GRANDfather]

alican bey yapmıs oldugunuz dosyayı denedim ama işe yaramadı
öğretmen beyin yapmıs oldugu dosya benim istedigime daha yakın ekte bir örnek gönderiyorum

 

[ozgretmen]

alican bey yapmıs oldugunuz dosyayı denedim ama işe yaramadı
öğretmen beyin yapmıs oldugu dosya benim istedigime daha yakın ekte bir örnek gönderiyorum

Aşağıdaki şekilde kodu değiştitir misin ?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A1:A65536]) Is Nothing Then Exit Sub
For x = 1 To Cells(65536, 1).End(xlUp).Row
If WorksheetFunction.CountIf(Range("A1:A" & x), Cells(x, 1)) > 1 Then
Cells(x, 1).Select
soru = MsgBox("Bunu daha önce girdin.Yine de Girme İster Misin ?", Buttons:=vbQuestion + vbYesNo)
If soru = vbYes Then
Else
Cells(1, 2).Value = ActiveCell.Row
Range("A1:A" & Cells(65536, 1).End(xlUp).Row).Find(ActiveCell.Text, LookIn:=xlValues, LookAt:=xlWhole).Select
Cells(Cells(1, 2).Text, 1) = ""
[B1] = ""
End If
End If
Next
End Sub