Kayıt tekrarını nasıl önleriz

[byfeat]

Uzun bir aradan sonra tekrar merhaba arkadaşlar
umarım herkesin sağlığı sıhhati yerindedir.
Forumdaki tüm dostların yeni yılını kutluyorum.

Sorunum ekli dosyada ön bilgi olarak buraya yazdım.
Kayıt anında; E , F ve G sütunlardaki veriler eğer üst satırda var ise;
engelleyecek yada uyaracak.
sayın Necdet_Yesertener üstadın
alttaki linkte 10 nolu mesajındaki olaya benzer formüle veya daha değişik çözüme ihtiyacım var.
http://www.excel.web.tr/showthread.php?t=42194

ADI TARİH SAYI
ALİ......24.12.... 256
VELİ....24.12.... 888
EMEL.....22.12.... 503
NACİ....13.12.... 242
SAMİ....25.12.... 666
EMEL.....22.12.... 503 bu veri 4 satırda var
ALİ.......22.12.... 241
ALİ......24.12....256 Bu veri 2 satırda var
ALİ.....25.12.... 256 Sayı aynı ancak tarih değişik


Daha önceden hücreleri biçimlendirilmiş bir dosyadan aynı biçimlendirmeleri
çalışma dosyama uygulamak istediğimde; "başka çalışma sayfasından veya kitabından uyarlanamaz" vs. gibi uyarı
verdiğinden başaramadım.
HAZIRLIK DOSYASI EKTEDİR TEŞEKKÜRLER.

 

[Ali]

Bana göre en pratik yöntem E&F&G sütunlarındaki değerleri bir sütunda birleştirip mükerrer kayıdı önlemektir.

 

[byfeat]

Bana göre en pratik yöntem E&F&G sütunlarındaki değerleri bir sütunda birleştirip mükerrer kayıdı önlemektir.

Sevgili Ali
tek sütun yaptığımız zaman
sayıları tarihleri veya isimleri aradığımızda ctrl+F dediğimizde hemen hemen bütün verileri bulacak
Tüm Hücre içeriğini eşleştir demiş olsak bile tüm veriler gözümüz önüne gelecek
örnek dosya gibi değil olay en az 3000-4000 kayıt olacak çünki
ama gizli bir sütunda yada sayfada aynı verileri birleştirerek gibi bişey belki olabilir sanki..
Sevgilerimle

 

[Ali]

tek sütun yaptığımız zaman
sayıları tarihleri veya isimleri aradığımızda ctrl+F dediğimizde hemen hemen bütün verileri bulacak

CTRL+F farklı bir işlem sizin mükerrer kayıtlarınızın hepsini bulması farkı bir olay.

Eğer aşağıda linkte bu konu ile ilgili örnek çalışmaları incelerseniz sorununuzun çözüleceğine inanıyorum.

http://www.excel.web.tr/forumdisplay.php?f=120

 

[byfeat]

sevgili Ali bey alakanıza teşekkür ederim

ancak bir yanlış anlaşılmayı düzeltmek isterim
ctrl+F yi mükerrer kayıtları bulmak için değil zaman içinde aranan herhangi
bir kaydı araştırmak için kullanıyorum.
mükerrer olayı ilk anladığınız şekilde
örnek :
bayx den gelen bir evrak tarih ve sayı aynen üst satırlarda var ise uyarı almak
aynı sayı başka firmadan da gelmiş olabilir o zaman uyarı vermeyecek

ayrıca daha önceden koşullu biçimlendirme yapılmış başka bir çalışma kitabımda
olay çözülmüştü bu yazı ekinde sunuyorum.
CD den kopya aldım yeni işyerimde aynı olayı uygulamak istiyorum,
ama ilk mesajda yazdığım gibi uyarı alıyorum biçim boyacısıyla da başaramadım
çalışmadı birebir aynı verileri yazıncada olmadı
bunun bir nedeni varmı acaba
aynı kitaptan devam edin diyeceksiniz
olmayacak asıl çalışma kitabında bağlantılar ve formüller içeren farklı sayfalarım var.
Yardımlarınız için teşekkürler, Mutlu Yıllar.

 

[Ali]

Eğer üç değerde aynı olunca silinecekmi yoksa sadece uyaracakmı?

 

[byfeat]

Eğer üç değerde aynı olunca silinecekmi yoksa sadece uyaracakmı?

Ali bey
mükerrer kayıt olmaması için
uyarması yeterli olacak
çünki var olan kayıtlardan mükerrer araması yapmak değil
giriş anında tekrar etmemek maksadımız,
ekli dosyadaki mevcut koşulları neden diğer kitaba uygulayamadığım hakkında da
bilgim-iz olsun isterim.
PC değişikliği veya başka bir ayarlarmı anlayamadım
kolaygelsin

 

[Ali]

Birleştirme yaptığınız sütun için aşağıdaki linkteki çalışmanın

Mükerrer-7 adlı kısmındaki Veri-Doğrulama kısmı çalışmanıza uyarlayın.

Mükerrer (Çift) Kayıt Engelleme,Sayma Örnekleri

 

[byfeat]

Ali Bey
verdiğiniz link ve emek için teşekkür ederim
her türlü mükerrer için örnekler var
oradan daha öncedende kısmen faydalandım ancak benim çalışma kitabımdaki olay için oradan uygulama yapamıyorum
5 nolu mesajımdaki sorunu halledebilirsem mesele kalmayacak

 

[Ali]

Silinmesini istemediğiniz ve sadece görmek istediğiniz için sütun birleştirme ve formül ile 3 sütununuzdaki mükerrer tekrarları görmeniz için koşullu biçimlendirme yaptım. M sütunu birleştirilmiş sütununuz N sütunu mükerrer veri var ise bir yazmaktadır.

E,F ve G sütunlarıda mükerrer olan satırları renklendirmektedir.Biçim-Koşullu biçimlendirme kısmına bakarsanız orada formülü görebilirsiniz.

Örneğiniz ektedir.

 

[byfeat]

Ali bey

henüz dosyayı açmadım ama açıklamanızdan anladığım kadarıyla olmuş
zahmet verdim
Hakkınızı helal ediniz
emekleriniz için teşekkürler

 

[byfeat]

Ali Bey

çözümünüzü uyarladım Çalışıyor.
Zamanla kayıtlar arttıkça formüllerde çoğalacak dosyaya aşırı yük olacak gibi
yine sizin önerinizdi sanıyorum
yada başka bir üstadımızın
böyle bir formül vardı
değişik denemelerde kullandım başlangıçta 25-30 satırda çalışıyor sonrasında işlev yapmıyor
acaba aşağıdaki kodlamalarda nereleri değiştirebilirim.
Kusurumu bağışlayın
PC mi çocuğa İstanbul'a bıraktım ben Ankaraya yerleştim.
emeklilik, iş ve şehir değişikliği vs. derken yaklaşık 1 yıla yakındır bırakın exceli pc ile bir alakam olmadı
geceleri ilham saatlerinde uygulama yapabilecek ortamım yok
Sadece işyerinde vakit buldukça yeni yıla hazırlık yapmam gerekiyor
zaman içinde kendi yaptığım uygulamalara bile hayretle bakar oldum nasıl yapmışım diye (malum yaşlılık biraz)
sevgilerle

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [D1:d5000,E1:F5000,G1:G5000]) Is Nothing Then Exit Sub
If IsEmpty(Target) Or InStr(1, Target.Address, ":") <> 0 Then Exit Sub
If Cells(Target.Row, "D") <> "" And Cells(Target.Row, "E") <> "" And Cells(Target.Row, "F") <> "" And Cells(Target.Row, "G") <> "" Then
SAY = WorksheetFunction.CountIf(Columns(Target.Column), Target)
If SAY > 1 Then
Set BUL = Columns(Target.Column).Find(Target)
If Not BUL Is Nothing Then
ADRES = BUL.Address
Do
If Cells(Target.Row, "D") = Cells(BUL.Row, "D") And Cells(Target.Row, "E") = Cells(BUL.Row, "E") And Cells(Target.Row, "F") = Cells(BUL.Row, "F") And Cells(Target.Row, "G") = Cells(BUL.Row, "G") Then
SATIR = IIf(SATIR = "", BUL.Row & Space(1), SATIR & ", " & BUL.Row & Space(1))
End If
Set BUL = Columns(Target.Column).FindNext(BUL)
Loop While Not BUL Is Nothing And BUL.Address <> ADRES
GoTo UYARI
End If: End If: End If
GoTo SON
UYARI: ONAY = MsgBox("Bu kayıt daha önce aşağıdaki satırlarda girilmiştir !" & Chr(10) & Chr(10) & SATIR & Chr(10) & Chr(10) & "İşleme devam etmek istiyor musunuz?", vbYesNo + vbCritical, "DİKKAT !")
If ONAY = vbNo Then
Cells(Target.Row, "D") = ""
Cells(Target.Row, "E") = ""
Cells(Target.Row, "F") = ""
Cells(Target.Row, "G") = ""
Target.Select
Exit Sub: End If
Target.Offset(1, 0).Select
SON:
End Sub


Private Sub CommandButton1_Click()

End Sub

 

[Ali]

O zaman tüm formülleri iptal edin aşağı makroyu bir deneyin.

İkinci defa geçen kayıtları sarı renk ile işaretler.

Sub mükerrer()
Dim k
Dim benzer As Range
Dim satirlar As Integer
satirlar = 0
On Error Resume Next
    For Each benzer In Range("G1:" & "G" & Range("G5000").End(3).Row)
For k = 2 To Range("G5000").End(3).Row
            If benzer = Range("G" & k + satirlar) And benzer.Offset(0, -1) = Range("F" & k + satirlar) And benzer.Offset(0, -2) = Range("E" & k + satirlar) Then
               Range("G" & k + satirlar).EntireRow.Interior.ColorIndex = 6
 
            End If
            Next
        satirlar = satirlar + 1
    Next
End Sub

 

[byfeat]

Evet Ali Bey
2-3 gündür kıymetli zamanınızı istemeden çaldım
çözüm bu şekilde güzel tekrar edilenleri bulmak için formül arayanların çok işine yarayacak.
En anlaşılır ve en kolay yöntemle sunulmuş eline sağlık.

Ancak var olan mükerrerleri bulmakta işe yarıyor
oysaki benim istediğim olay hücrelere verileri girerken aynı şekil olmalı

bu sistemde her defasında makro çalıştır demek icabediyor
ayrıca mükerrer olupta sarıya boyanmış kısımlardaki verileri değiştirsem bile renk aynı kalıyor
sanırım anlatabildim.

 

[Ali]

Ancak var olan mükerrerleri bulmakta işe yarıyor
oysaki benim istediğim olay hücrelere verileri girerken aynı şekil olmalı
.

Sayfaya veri girerken gerçekleşsin diyorsanız o zaman sayfa sekmenizi sağ tuş ile tıklayıp kod görüntüle kısmını seçtikten sonra aşağıdaki kodları yapıştırınız.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Range("E2:G500").Interior.ColorIndex = xlNone
Dim k
Dim benzer As Range
Dim satirlar As Integer
satirlar = 0
On Error Resume Next
    For Each benzer In Range("G1:" & "G" & Range("G5000").End(3).Row)
For k = 2 To Range("G5000").End(3).Row
            If benzer = Range("G" & k + satirlar) And benzer.Offset(0, -1) = Range("F" & k + satirlar) And benzer.Offset(0, -2) = Range("E" & k + satirlar) Then
               Range("G" & k + satirlar).Interior.ColorIndex = 6
               Range("F" & k + satirlar).Interior.ColorIndex = 6
               Range("E" & k + satirlar).Interior.ColorIndex = 6
            End If
            Next
        satirlar = satirlar + 1
 Next
Application.ScreenUpdating = True
End Sub

 

[byfeat]

OLAY BUDUR
ÇÖZÜM BUDUR

Sağolasın Ali Bey
Allah razı olsun