• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Farklı sayfalardaki verileri benzersiz şekilde alt alta listeleme

O

ordulu82

Altın Üye
Katılım
24 Mart 2006
Mesajlar
215
Selamlar. Ekteki örnekte olduğu gibi farklı sayfalarda bazıları da mükerrer olan verilerim var. Bunların başka sayfaya formül kullanarak benzersiz olarak alt alta aktarılması sağlanabilir mi. Excel 2010 kullanıyorum.
 

Ekli dosyalar

Korhan Ayhan' Alıntı:
Formül kullanmak işleri zorlaştırabilir.

Makro ile daha pratik olacaktır.

Arama Sonuçları
Genişletmek için tıkla ...
Hocam tüm örnekleri inceledim ama benim listeme uygun bir örnek bulamadım. Çünkü bazı örnekler sadece bir sütunu listeliyor, bazıları benim istediğim gibi birden fazla hücreyi kopyalıyor fakat benzersiz kayıtları süzmüyor. Rica etsem ekteki örneği inceler misiniz. Çünkü 3 hücre toplam sayfasına listelenecek, benzersiz kayıtlar kimlik numarasına göre belirlenecek.
 

Ekli dosyalar

Merhaba,
@Korhan Ayhan üstadın affına sığınarak, aşağıdaki kodu öneriyorum.
C++: 
Sub Benzersiz()
    Application.ScreenUpdating = False
    Set s1 = Sheets("TOPLAM")
    s1.Range("B8:D" & Rows.Count).ClearContents
For i = 2 To Sheets.Count
    ss = Sheets(i).Cells(Rows.Count, 4).End(3).Row
    ss1 = s1.Cells(Rows.Count, 2).End(3).Row + 1
    Sheets(i).Range("B8:D" & ss).Copy s1.Range("B" & ss1)
Next i
    s1.Range("B8:D" & Cells(Rows.Count, 4).End(3).Row).RemoveDuplicates 1, xlNo
    Application.ScreenUpdating = True
End Sub
 
dEdE' Alıntı:
Merhaba,
@Korhan Ayhan üstadın affına sığınarak, aşağıdaki kodu öneriyorum.
C++: 
Sub Benzersiz()
    Application.ScreenUpdating = False
    Set s1 = Sheets("TOPLAM")
    s1.Range("B8:D" & Rows.Count).ClearContents
For i = 2 To Sheets.Count
    ss = Sheets(i).Cells(Rows.Count, 4).End(3).Row
    ss1 = s1.Cells(Rows.Count, 2).End(3).Row + 1
    Sheets(i).Range("B8:D" & ss).Copy s1.Range("B" & ss1)
Next i
    s1.Range("B8:D" & Cells(Rows.Count, 4).End(3).Row).RemoveDuplicates 1, xlNo
    Application.ScreenUpdating = True
End Sub
Genişletmek için tıkla ...
Hocam teşekkür ederim harika bir çalışma olmuş. Sanırım eklemeyi unuttuğum bir şey oldu. Eklediğim örnekte 4 ay var ama asıl listem Ocak ile Aralık ayları arasında 12 ay var. Bir de aralığı B8 ile D500 arasında yapmak istersek nasıl düzenleme yapabiliriz. Ben koddaki "B8:D" kısmını B8:D500 yaptım ama olmadı. Sanırım o kadar basit değil :)
 
Merhaba,
Kodda hiçbir değişiklik yapmanıza gerek yok.
Sayfa ve sayfalara satır ekledikçe kod onları algılayacak şekilde düzenlendi.
 
dEdE' Alıntı:
Merhaba,
Kodda hiçbir değişiklik yapmanıza gerek yok.
Sayfa ve sayfalara satır ekledikçe kod onları algılayacak şekilde düzenlendi.
Genişletmek için tıkla ...
Üstad çalışma sayfasında Ocak-Aralık arasındaki aylardan başka çok farklı sayfalar var. Kodu çalıştırdığımda o sayfalardan da veri çekiyor. O yüzden sayfa aralığı belirtmemiz gerekiyor.
 
@dEdE,

Cevap vermek için af dilemeye ya da izne ihtiyacınız yok. Alternatifler her zaman iyidir. ;)

Ben sadece üyelerimizin kendilerini geliştirmeleri için genellikle arama sonuçlarını öneriyorum. Yoksa tekrar tekrar aynı cevapları vermiş oluyoruz.

Bende Dictionary ile hazırladığım örnek dosyayı arşivde bulunması açısından paylaşıyorum.
 

Ekli dosyalar

Kodlar örnek dosyanıza göre hazırlandı...
 
Merhaba,

Soru/sorun aynı. Sorularımızı eksik soruyor, örnek dosyamızı sorumuza/sorunumuza uygun hazırlamıyoruz.
#1 numaralı mesajınıza ekli örnek dosyanız sadece Ocak-Mayıs aylarını içeriyor ve kişilerden(sadece ad) oluşuyor.
#3 numaralı mesajınıza ekli örnek dosyanız yine Ocak-Mayıs aylarını içeriyor, kimlik numarası, adı, soyadı var ve benzersiz kayıtlar kimlik numarasına göre belirlenecekmiş.
#5 numaralı mesajınızda “...Sanırım eklemeyi unuttuğum bir şey oldu. Eklediğim örnekte 4 ay var ama asıl listem Ocak ile Aralık ayları arasında 12 ay var...” diyorsunuz. Bu durumu varsayıp, Ocak-Aralık olmalı diye tahminde bulunup tüm ayları kapsayacak şekilde kod yazıyoruz.
#7 numaralı mesajınızdan anlıyoruz ki; “...Ocak-Aralık arasındaki aylardan başka çok farklı sayfalar var...” mış. Bunu tahmin edemedik. :)
#10 numaralı mesajınızdan ise “...A sütununa sıra numarası eklemek ...” istediğinizi anlıyoruz.
Bütün bunları ilk mesajınızda ve ilk örnek dosyanızda belirtmeliydiniz.

Neyse, aşağıdaki kod umarım isteğinizi karşılar.
C++: 
Sub Benzersiz()
    Application.ScreenUpdating = False
    Set s1 = Sheets("TOPLAM")
    s1.Range("A8:D" & Rows.Count).ClearContents
    myArr = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
For k = 0 To 11
    For i = 1 To Sheets.Count
         If Sheets(i).Name = myArr(k) Then
            ss = Sheets(i).Cells(Rows.Count, 4).End(3).Row
            ss1 = s1.Cells(Rows.Count, 2).End(3).Row + 1
            Sheets(i).Range("B8:D" & ss).Copy s1.Range("B" & ss1)
        End If
    Next i
Next k
    s1.Range("B8:D" & Cells(Rows.Count, 4).End(3).Row).RemoveDuplicates 1, xlNo
    s1.Range("A8") = 1
    s1.Range("A8:A" & Cells(Rows.Count, 2).End(3).Row).DataSeries
    s1.Range("B8:D" & Cells(Rows.Count, 4).End(3).Row).Sort Key1:=[B1], Order1:=1
    Application.ScreenUpdating = True
End Sub
 
dEdE' Alıntı:
Merhaba,

Soru/sorun aynı. Sorularımızı eksik soruyor, örnek dosyamızı sorumuza/sorunumuza uygun hazırlamıyoruz.
#1 numaralı mesajınıza ekli örnek dosyanız sadece Ocak-Mayıs aylarını içeriyor ve kişilerden(sadece ad) oluşuyor.
#3 numaralı mesajınıza ekli örnek dosyanız yine Ocak-Mayıs aylarını içeriyor, kimlik numarası, adı, soyadı var ve benzersiz kayıtlar kimlik numarasına göre belirlenecekmiş.
#5 numaralı mesajınızda “...Sanırım eklemeyi unuttuğum bir şey oldu. Eklediğim örnekte 4 ay var ama asıl listem Ocak ile Aralık ayları arasında 12 ay var...” diyorsunuz. Bu durumu varsayıp, Ocak-Aralık olmalı diye tahminde bulunup tüm ayları kapsayacak şekilde kod yazıyoruz.
#7 numaralı mesajınızdan anlıyoruz ki; “...Ocak-Aralık arasındaki aylardan başka çok farklı sayfalar var...” mış. Bunu tahmin edemedik. :)
#10 numaralı mesajınızdan ise “...A sütununa sıra numarası eklemek ...” istediğinizi anlıyoruz.
Bütün bunları ilk mesajınızda ve ilk örnek dosyanızda belirtmeliydiniz.

Neyse, aşağıdaki kod umarım isteğinizi karşılar.
C++: 
Sub Benzersiz()
    Application.ScreenUpdating = False
    Set s1 = Sheets("TOPLAM")
    s1.Range("A8:D" & Rows.Count).ClearContents
    myArr = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
For k = 0 To 11
    For i = 1 To Sheets.Count
         If Sheets(i).Name = myArr(k) Then
            ss = Sheets(i).Cells(Rows.Count, 4).End(3).Row
            ss1 = s1.Cells(Rows.Count, 2).End(3).Row + 1
            Sheets(i).Range("B8:D" & ss).Copy s1.Range("B" & ss1)
        End If
    Next i
Next k
    s1.Range("B8:D" & Cells(Rows.Count, 4).End(3).Row).RemoveDuplicates 1, xlNo
    s1.Range("A8") = 1
    s1.Range("A8:A" & Cells(Rows.Count, 2).End(3).Row).DataSeries
    s1.Range("B8:D" & Cells(Rows.Count, 4).End(3).Row).Sort Key1:=[B1], Order1:=1
    Application.ScreenUpdating = True
End Sub
Genişletmek için tıkla ...
Elinize sağlık hocam mükemmel olmuş. Çok teşekkür ederim.
 
Bende son paylaştığım örnek dosyayı revize ederek ekte yeniden paylaşıyorum.
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst