Mükerrer Kayt hk.

[cqners]

Merhaba;

Site içerisinde mükerrer kayıtla ilgili güzel verilere mevcut, isteğimi karşılamadığından konu hakkında bilginize ihtiyacım var.

Örn.

Aynı Sütüna eklenen aynı ikinci verinin kalması, birinci eklenen verinin silinmesi.

Sütün A da bulunan 47.Satırda Ali var ise 89.Satıra Ali girdiğimde 47.Satır da Sütun A dan Sütun G ye kadarki verilerin silinmesi, veya 47.Satırın komple silinmesi ile aşağıdaki verilerin yukarı kayması.

Yukarıda belirtilen konu hakkında yardımlarınızı rica eder, iyi akşamlar dilerim.

--------------------------------------------------------------------------
Dosyanın en son güncel hali aşağıdaki ektedir. Umarım İşinize Yarar.

Saygılarımla;
Caner SARIGÜL

 

[Recep İpek]

Aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [a:a]) Is Nothing Then Exit Sub
say = WorksheetFunction.CountIf(Range("a2:a" & Target.Row - 1), Target)
veri = Target
If say > 0 Then
If (MsgBox("Bu Kayıt Mevcut." & Chr(13) & Chr(13) & "İlk Kaydı Silmek İstiyormusunuz?", vbCritical + vbDefaultButton2 + vbYesNo, "UYARI")) = vbYes Then
For Each alan In Range("a2:a" & Target.Row - 1)
If alan.Value = veri Then
alan.Select
Selection.EntireRow.Delete
End If
Next
End If
End If
End Sub

 

[cqners]

Sayın Ripek


Belirttiğiniz kodu kullanamadım.

Talebimin daha net anlaşılması için aşağıdaki Ek'li örnek dosyayı bilginize sunarım.
Bu ekli dosya üzerinde gerekli uygulamayı yapabilirsek daha net anlayacağıma eminim.

Kaytlar da toplu değişiklikler olacağından, onay kutusu veya uyarı vermesine gerek yok, zaman kaybına neden olabilir, bilginize sunarım.


Saygılarımla,
Caner SARIGÜL

 

[Recep İpek]

Ekteki dosyanızı inceleyiniz.

A kolonuna herhangi bir bilgi girdiğinizde otomatik olarak ilk kaydı siler.

 

[cqners]

Sayın Ripek,

Verilerde toplu değişiklik yapınca bunu algılamıyor.

Örn. Veriler Kopyalanmış ve yapıştırıldığında proğram geriye dönük silme gerçekleştirmiyor.

1 bilgi bilgi bilgi bilgi Kopya edip 'A' yapıştırdığımda silme gerçekleşmedi.
1 bilgi bilgi bilgi bilgi
1 bilgi bilgi bilgi bilgi
1 bilgi bilgi bilgi bilgi
2 bilgi bilgi bilgi bigi
2 bilgi bilgi bilgi bigi
2 bilgi bilgi bilgi bigi

 

[cqners]

Kopyalama Hatası.

Sayın Ripek,

Tüm değişik kopyalama yöntemlerini denedim.

Kayıtlar tek tek girince sistem çalışmakta fakat toplu güncellemelerde proğram yanıt vermemkte. Bilginize sunarım.


Saygılarımla,
Caner SARIGÜL

 

[Recep İpek]

Pardon.Ben sorunuzu A kolonuna veri girildikçe ilk kayıtların silinmesi olarak anlamıştım.Toplu güncelleme için bir sorum olacak.

Mükerrer kayıt 2'den fazla olanlar var mı? Eğer var ise sadece son kayıt mı kalacak?Yoksa sadece ilk kayıt mı silinecek?

 

[cqners]

Sn. Ripek,

Güncelemeler çok sık yapılmakta, mükerrer kayıtlar ise enaz 2 en çok 200 civarında olacak ve kopyala yapıştır mantığı ile güncellenecek.
Sadece son kayt kalacak.

Mesala A sütünunda şu bilgiler var
1! 2! 3! '8 '9 '7 '13

kopya aldığım bilgiler
1! 2! '3 4! 5! 1! 6! 2! '6 5! '4 '1 '2 '5 var ise sadece '1 '2 '3 '4 '5 '6 kalacak

Silinecekler 1! 2! 3! 4! 5! 1! 6! 2!

A Sütununda kalacak veriler . 1 2 3 4 5 6 7 8 9 13 Eski kalması gereken ve kopya içerisindeki son satırdaki yeni veriler.


Değişiklikten Sonra silinecekler ! işarati ile kalacaklar ' işareti ile belirtilmiştir.

Saygılarımla,
Caner SARIGÜL

 

[cqners]

Açık örnek dosyam

Forum'da şu veriyle karşılaştım.


Sub sil()
For a = [a65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("a1:a" & a), Cells(a, "a")) > 1 Then Rows(a).Delete
Next
MsgBox "işlem tamamlandı"
End Sub

Buna benzer bir örnek istiyorum fakat burada ilk veri kalmakta en alt veriyi silmektedir.

Bunla ilgili örnek dosyam ekte inceleme şansın olursa yardımcı olacağına eminim.

Saygılarımla;
Caner SARIGÜL

 

[Recep İpek]

Sorunuz hem ilginç, hemde güzel bir soru.

Biraz fantazi olacak ama verilerinizi ters sıralayarak yukarıdaki kodu çalıştırabilirsiniz.Örneğin B kolonunu önce Data>> Sort'tan Destencding ile ters sıralayın.Daha sonra bu makroyu B kolonu olarak düzeltip çalıştırabilirsiniz.

 

[cqners]

Başaramadım, konu hakkında dosya ekleye bilirsen anlayacağıma eminim.

 

[veyselemre]

Aşağıdaki kodu deneyin.

Sub sil()
son = [a65536].End(3).Row - 1

For x = 4 To son
    If WorksheetFunction.CountIf(Range("a" & x + 1 & ":a" & son), Cells(x, "a")) >= 1 Then Cells(x, "a") = ""
Next

For x = son To 4 Step -1
    If Cells(x, "a") = "" Then Rows(x).Delete
Next


End Sub

 

[veyselemre]

Mesaj yanlışlıkla 2.kez gittiğinden mesaj silindi.

 

[cqners]

Harika.....
Sn. Ripek, Veyselemre.

Yapacağım çalışmada işin özü olan formul yardımlarınız sayesinde ortaya çıktı.

Excel'e yeni başlayan biri olarak, bilgisini ve tecrübesini koşulsuz paylaşan sizler'e sonsuz teşekkürler.

Paylaşım Budur, Ortam Budur, Forum Budur.....

Saygılarımla;
Caner SARIGÜL

 

[cqners]

Son güncelemede yaptığım kontrolde hata fark edilmiştir.

Aşağıdaki ekli örnekte problemi göre bilirsiniz, ilginiz için tş.

 

[veyselemre]

Sub sil()
son = [a65536].End(3).Row - 1

For x = 4 To son
    If WorksheetFunction.CountIf(Range("a" & x + 1 & ":a" & son [B][COLOR=Red]+ 1[/COLOR][/B]), Cells(x, "a")) >= 1 Then Cells(x, "a") = ""
Next

For x = son To 4 Step -1
    If Cells(x, "a") = "" Then Rows(x).Delete
Next

Range("a4:c" & [a65536].End(3).Row).Sort Key1:=Range("A4")
End Sub

 

[cqners]

Sn.Veysel Bey,

Ben sorumu yazarken cevap gelmiş, Harika.

 

[cqners]

Kayan ve Bozulan Formul Hk.

Aşağıdaki ekte iki sayfa yer almakta

Veriler sayfasında problem yok.
Sırala sayfasında veriler sayfasını çalıştırınca formul sırası bozulmakta.

Örnek dosyayı incelerseniz problemi göreceksiniz.

Konu hakkında yardımlarınızı rica ederim.

Saygılarımla;
Caner SARIGÜL

 

[veyselemre]

Veriler sayfasında problem yok.
Sırala sayfasında veriler sayfasını çalıştırınca formul sırası bozulmakta.

Bundan doğal bir şey yok sırala sayfasındaki formüller veriler sayfasıyla bağlantılı bu yüzden aynı satırları da sırala sayfasından silmek çözüm olabilir.

Sub sil()
son = [a65536].End(3).Row - 1

For x = 4 To son
    If WorksheetFunction.CountIf(Range("a" & x + 1 & ":a" & son + 1), Cells(x, "a")) >= 1 Then Cells(x, "a") = ""
Next

For x = son To 4 Step -1
    If Cells(x, "a") = "" Then Rows(x).Delete: Sheets("sırala").Rows(x - 3).Delete
Next

Range("a4:c" & [a65536].End(3).Row).Sort Key1:=Range("A4")
End Sub

 

[cqners]

Sn.VeyselEmre

İlginiz için teşekkürler.

Saygılarımla;
Caner SARIGÜL