Tekrar Edilen Kayıtları Yeni Sayfaya Kopyalamak

[viperciyes]

Merhabalar,
uzun süredir gizli takip eden yeni üyelerden biriyim. açıkçası çok uğraştım bu konuyu açmamak için ama sanırım kimsenin bu tür bir ihtiyacı olmamış. Şimdi yapmak istediğim şey, elimde yaklaşık 5000 kişilik bir excel tablosu, A-O arası sütunlarda ise bu kişilerle ilgili veriler bulunmakta. yapmak istediğim şey, B sütununda tekrarlanan veri var ise, bu tekrarlanan verileri başka bir sayfaya tekrarlanan veriler alt alta gelecek şekilde (A-O sütunlarındaki verileriyle birlikte) kopyalamak. Ekteki dosyada sayfa adları ve sayfalardaki açıklamalarda daha detaylı anlattım elimdekini ve ne istediğimi. Yardımcı olabilirseniz çok sevinirim.
bir de, kod yazılacaksa, ben 37'lik bir liste gönderdim ama uğraşacağım liste yaklaşık 5000 kişilik, bilgi vereyim dedim.

Şimdiden elinize sağlık.

 

[N.Ziya Hiçdurmaz]

yanıt

Sub aktar()
Dim sat As Integer
Dim s As Integer
Sayfa2.[a10:p5000] = ""
s = 10
    For sat = 10 To Sayfa1.Cells(65536, "b").End(xlUp).Row
        If WorksheetFunction.CountIf(Sayfa1.Range("b10:b" & sat), Sayfa1.Cells(sat, "b")) > 1 Then
            Range(Sayfa2.Cells(s, "a"), Sayfa2.Cells(s, "o")) = Range(Sayfa1.Cells(sat, "a"), Sayfa1.Cells(sat, "o")).Value
            Sayfa2.Cells(s, "p") = Sayfa1.Cells(sat, "b").Address
            s = s + 1
        End If
    Next
End Sub

 

[viperciyes]

Üstat ellerine sağlık, bu da işimi görür ancak, ben tekrarlanan her iki verinin de yeni sayfaya listelenmesini istiyordum. zira yan sütunlarda bulunan veriler arası karşılaştırma yapmam gerek. bu kod sadece tekrarlanan 2. veriyi kopyaladı. yine de sağolasın ve bu kadar hızlı cevap için ayrıca teşekkürler.

 

[N.Ziya Hiçdurmaz]

yanıt

Sub aktar()
Dim sat As Integer
Dim s As Integer
Sayfa2.[a10:p5000] = ""
s = 10
    For sat = 10 To Sayfa1.Cells(65536, "b").End(xlUp).Row
        If WorksheetFunction.CountIf(Sayfa1.[b:b], Sayfa1.Cells(sat, "b")) > 1 Then
            Range(Sayfa2.Cells(s, "a"), Sayfa2.Cells(s, "o")) = Range(Sayfa1.Cells(sat, "a"), Sayfa1.Cells(sat, "o")).Value
            Sayfa2.Cells(s, "p") = Sayfa1.Cells(sat, "b").Address
            s = s + 1
        End If
    Next
End Sub

 

[viperciyes]

Peki, acemice bir soru olacak ancak, ben bu kodu başka bir excel dosyasında (aynı sütunlarda) uygulamak için sadece sayfa adlarını sayfa1 sayfa2 olarak mı bırakmam gerek, yoksa değiştirmem gereken başka bir yer de var mıdır?

 

[Skorpiyon]

Sayın viperciyes,

Aynı sütunlarda kullanacaksanız, Sayfa isimlerinizin Sayfa1 ve Sayfa2 olması yeterlidir.

 

[viperciyes]

teşekkür ederim. beni büyük bir yükten kurtardınız.

 

[necip54]

Sub aktar()
Dim sat As Integer
Dim s As Integer
Sayfa2.[a10:p5000] = ""
s = 10
    For sat = 10 To Sayfa1.Cells(65536, "b").End(xlUp).Row
        If WorksheetFunction.CountIf(Sayfa1.[b:b], Sayfa1.Cells(sat, "b")) > 1 Then
            Range(Sayfa2.Cells(s, "a"), Sayfa2.Cells(s, "o")) = Range(Sayfa1.Cells(sat, "a"), Sayfa1.Cells(sat, "o")).Value
            Sayfa2.Cells(s, "p") = Sayfa1.Cells(sat, "b").Address
            s = s + 1
        End If
    Next
End Sub

Benim de buna benzer bir problemim var, bu örneği kendime uyarlamak istedim ancak beceremedim.

A sütunundaki Poliçe numaraları ile B sütunundaki Poliçe numaralarından bazıları aynı satırda OLMAYACAK şeklide eşleşmektedir. İstenilen :
A sütunundaki sayılardan herbiri ile B sütunundaki eşleşen sayı lerın herbiri ve onların sağında bulunan aynı satırdaki bütün değerleri Sayfa2 de A2:I2 satırından başlayarak her eşleşeni alt alta gelecek şekilde aktarmak gerekiyor.(Sayfa2 de gösterilmiştir)
Not:C,D,E,F,G,H,I daki değerler B nin ayrılmaz parçalarıdır.Aktarma işleminde B,C,D,E,F,G,H,I birlikte aktarılmalıdır.

Teşekkürler,