Mükerrer Kayıt Bulma ve Listeleme

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
698
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Sayın Uzman Arkadaşlar,

Son 3 yıl baz alınarak oluşturulan excel çalışma kitabında yıllara göre farklı sayfalarda veriler oluşturulmuştur. Oluşturulan bu veriler süzülerek mükerrer (Tekrar gelen misafirler) kayıtlar bulunarak listelenmek isteniyor. Çalışma kitabının her sayfasının "B" sütununda misafir isimleri mevcut olup, son üç yıl içerisinde gelenlerin listesi alınmak veya tespit edilmek istenmektedir. Örnek uygulamalardan bir sonuç alamadığım için siz uzman arkadaşların çok değerli yardımlarını rica ediyorum.

Saygılarımla.
 

Ekli dosyalar

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,091
Excel Vers. ve Dili
2007 Türkçe
Merhaba,
Ekteki dosyayı inceleyiniz...
Sayfa içlerinde mükerrer verilere koşullu biçimlendirme uygulandı.
Makro ile de liste oluşturuldu.
 

Ekli dosyalar

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
698
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Sayın mucit77,

2012, 2013 ve 2014 yıllarında aralıksız en az üç veya daha fazla gelen misafirler tespit edilmek isteniyor. Ayrıca önceki mesajda veri aralığını belirtmediğim için çok özür dilerim. Bu listeler "B1:B3500" aralığındaki verileri kontrol etmelidir. Aradığım kişilerin bazılarına hazırladığınız uygulamada ulaşamadım.

Saygılarımla.
 

ÖmerBey

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2012
Mesajlar
4,091
Excel Vers. ve Dili
2007 Türkçe
Kodu aşağıdaki şekilde değiştiriniz.
Kod:
Sub ListeOluştur()
Set liste = Sheets("Liste")
liste.Range("A:A").ClearContents
x = 2
For Each sayfa In Sheets
If sayfa.Name <> liste.Name Then
    For a = 1 To [COLOR="Red"]sayfa.Range("B65500").End(3).Row[/COLOR]
        For Each syf In Sheets
            If syf.Name <> liste.Name Then
                If WorksheetFunction.CountIf(syf.Range("B:B"), sayfa.Cells(a, "B")) > 0 Then
                    say = 1
                Else
                    say = 0
                    Exit For
                End If
            End If
        Next
        
        If say = 1 And WorksheetFunction.CountIf(liste.Range("A:A"), sayfa.Cells(a, "B")) = 0 Then
            liste.Cells(x, "A") = sayfa.Cells(a, "B")
            x = x + 1
        End If
        say = 0
    Next
End If
Next
End Sub
Her yıl listede adı geçenleri sıralar.
Kırmızı kısım kodun son dolu satıra göre çalışmasını sağlar. Belirttiğiniz gibi belirli bir alan istiyorsanız kırmızı kısmın yerine 3500 yazınız.
İsimlerde farklılık olması durumunda aradığınız kişilere ulaşamazsınız. (Görünürde aynı olabilir ama fazladan boşluk eklenmiş veriler da buna dahil)
 

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
698
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Sayın mucit77,

Konuya gösterdiğiniz ilgi ve değerli yardımlarınız için size çok teşekkür ederim.

Saygılarımla.
Ömer Ali ÜZÜMCÜ
 
Katılım
11 Şubat 2010
Mesajlar
202
Excel Vers. ve Dili
13 türkçe
Selamlar,
Ömer bey faydalı bir paylaşım. Sağolun. Bu kodu belirli sayfaları "Ana" sayfasındaki verilere göre arama yapabilir miyiz? Örneğin Ana sayfasındaki verileri sayfa x, sayfa y , sayfa z içinde arayalım. Listelenen isimleri de Ana Sayfadan alsın.Teşekkürler.
 
Katılım
11 Şubat 2010
Mesajlar
202
Excel Vers. ve Dili
13 türkçe
Güncel.
 
Üst