Soru Sadece belirtilen sayfalarda Mükerrer Kontrolü

[reosman]

Saygıdeğer Üstadlar,
Ekteki dosya sütun belirtilerek tüm sayfalarda mükerrer kontrolü yapmakta
Tüm sayfalarda değilde sadece belirtilen sayfalarda kontrol yaptırmak için
kodları hangi şekilde revize edebiliriz. Saygılarımla.

 

[yusuf1284]

https://www.excel.web.tr/threads/muekerrer-cift-kayit-engelleme-sayma-oernekleri.17185/

şu örneği inceler misin çok fazla seçenek var

 

[reosman]

İlginize çok teşekkür ederim Yusuf bey, örneği incelemiştim fakat benim talebimle ilgili örnek yok.

 

[reosman]

Örnege göre tüm sayfalarda arama yapıyor ben bazı sayfalarda arama yapmasını istediğimden arama yapılacak sayfaları ve sütunları belirtmek istiyorum.

 

[reosman]

Korhan hocam yukarıdaki uygulama sizin yapımınız rica etsem yardım edermisiniz.

 

[Korhan Ayhan]

Kod içindeki aşağıdaki satır arama yapılacak alanı ifade ediyor. Dilediğiniz gibi değiştirebilirsiniz.

Set Alan = Range("A1:Z1000")



Kod içindeki aşağıdaki satır ise çalışma kitabındaki tüm sayfaları işleme alıyor.

For Each Sayfa In ThisWorkbook.Worksheets

Koyu renkli bölümü aşağıdaki gibi düzenlerseniz sadece yazdığınız sayfalarda işlem yapacaktır.

For Each Sayfa In Sheets(Array("Sheet1", "Sheet3"))

 

[reosman]

Allah razı olsun hocam. Çok teşekkür ederim.

 

[reosman]

Hocam birde bu mükerrer kayıt bulma kaydı elle yazarken buluyor, kopyala yapıştır yapılırsa mükerreri bulmuyor. Bunun için ne yapabiliriz ?

 

[Korhan Ayhan]

Şöyle deneme yaptım.

A10 hücresine DENEME yazdım. Sonra bu hücreyip kopyalayıp C10 hücresine yapıştırdım.

Veri mükerrer olduğu için form ekrana geldi.

Yani kopyala-yapıştır işleminde de kodlar tepki veriyor.

 

[reosman]

Hocam toplu kopyala yapıştır yapınca bir fark olabilirmi. Saygılarımla.

 

[reosman]

hocam toplu kopyala yapıştır yapıldığında kod devreye girmiyor. Saygılarımla.

 

[Korhan Ayhan]

A1:A10 aralığına ALİ yazdım. Direkt form açıldı. Formu kapattım.

A1:A10 aralığını seçtim. Kopyala deyip B1 hücresine topla şekilde yapıştırdım. Yine form açıldı.

Yani bende sorunsuz çalıştı.

 

[reosman]

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim Sayfa As Worksheet, Alan As Range, Veri As Range, Aranan As String, Bul As Range, Adres As String, Mesaj As String, Dizi As Object, Say As Long
On Error Resume Next
Set Alan = Range("D21048576")

If Intersect(Target, Alan) Is Nothing Then Exit Sub

Set Dizi = CreateObject("Scripting.Dictionary")

ReDim Liste(1 To 3, 1 To 1)

For Each Sayfa In Sheets(Array("Yüreğir-2", "Yüreğir-4", "Sarıçam-2", "Sarıçam-4"))
For Each Veri In Target.Cells(1, 1)
If Veri.Value <> Empty Then
Set Bul = Nothing
Set Bul = Sayfa.Range(Alan.Address).Find(Veri.Value, LookAt:=xlWhole)
If Not Bul Is Nothing Then
Adres = Bul.Address
Do
Aranan = Sayfa.Name & "|" & Bul.Address & "|" & Bul.FormulaLocal
If Not Dizi.Exists(Aranan) Then
Say = Say + 1
Dizi.Add Aranan, Say
ReDim Preserve Liste(1 To 3, 1 To Say)
Liste(1, Say) = Sayfa.Name
Liste(2, Say) = Bul.Address
Liste(3, Say) = Bul.FormulaLocal
End If
Set Bul = Sayfa.Range(Alan.Address).FindNext(Bul)
Loop While Not Bul Is Nothing And Bul.Address <> Adres
End If
End If
Next
Next

If Say > 1 Then
With Mukerrer
.ListBox1.ColumnCount = 3
.ListBox1.ColumnWidths = "190;120;100"
.ListBox1.Column = Liste
.Show
End With
End If
End Sub

Hocam benim kodlar şu şekilde

 

[reosman]

Neyse hocam sizide yordum ilginize çok teşekkür ederim.

 

[Korhan Ayhan]

Bütün denemeleri ilk mesajda ki dosya üzerinde yaptım. Siz de o dosya üzerinde deneyip sonucu bildirir misiniz?

Eğer o dosyada sorun yoksa sizin dosyanızda farklı bir durum olabilir. Bu durumu çözebilmek için örnek dosya paylaşmanız gerekir.

 

[reosman]

Peki hocam bildireceğim.

 

[reosman]

Hocam sonuç olumsuz.
Şöyleki;

b-c-d-e sütunlarından örneğin 5 satır birlikte kopyala yapıştır yapınca mükerrer bulmuyor.

Sadece D sütunundan örneğin 5 satır kopyala yapıştır yapınca buluyor.

 

[reosman]

Korhan hocam yardımınızı rica ediyorum

 

[Korhan Ayhan]

Evet çalışmanın özü tek hücre veri girişi üzerine kurgulanmıştı.

Çoklu hücre sorgusu için "ThisWorkbook" bölümünde ki aşağıdaki satırı bulun ve bir sonraki satır ile değiştirip deneyin.

Eski hali;
For Each Veri In Target.Cells(1, 1)

Yeni hali;
For Each Veri In Target

 

[reosman]

Hocam allah sizden razı olsun deneyeceğim