mükerrer kayıtları sütunları ekleme

[hayalmeyal]

Hayırlı geceler. acil yardımınıza ihtiyacım var.
8 sütunluk(A dan H ye kadar) binlerce satırlık bir verim var.
A Sütununda dosya numarası, diğer sütunlarda kişinin farklı verileri var.

Bu listede aynı dosya numarrası olan kişilerin verilerinin alt alta değilde, aynı satırda yanyana olması gerekiyor.

Doğrudan işleyişi anlatmakda fayda var.
A1'e bakacak, eğer A1'deki değer, diğer alt satırlarda varsa, alt satırda B sütunundan H sütununa kadar olan veriyi yine A1 Satırına, H den sonraki sütuna yazarak devam edecek,

Bu şekilde mükerrerlik, çok fazla olabilir. yani aynı dosya numarasının birden fazla başvurusu olabilir.

Açıkçası makro yazamıyorum, Formul olarak da kafamda toparlayamadım.
Yardımcı olursanız çok memnun olurum.

Eke örnek çalışmayı koydum. Altın üyelik olmadan ek koymanın sakıncası varmı tam emin olamadım. Varsa hatamız affola.
https://yadi.sk/i/riIGc3SdefSJQ

 

[PLİNT]

Hayırlı geceler. acil yardımınıza ihtiyacım var.
8 sütunluk(A dan H ye kadar) binlerce satırlık bir verim var.
A Sütununda dosya numarası, diğer sütunlarda kişinin farklı verileri var.
Bu listede aynı dosya numarrası olan kişilerin verilerinin alt alta değilde, aynı satırda yanyana olması gerekiyor.
Doğrudan işleyişi anlatmakda fayda var.
A1'e bakacak, eğer A1'deki değer, diğer alt satırlarda varsa, alt satırda B sütunundan H sütununa kadar olan veriyi yine A1 Satırına, H den sonraki sütuna yazarak devam edecek,
Bu şekilde mükerrerlik, çok fazla olabilir. yani aynı dosya numarasının birden fazla başvurusu olabilir.
Açıkçası makro yazamıyorum, Formul olarak da kafamda toparlayamadım.
Yardımcı olursanız çok memnun olurum.
Eke örnek çalışmayı koydum. Altın üyelik olmadan ek koymanın sakıncası varmı tam emin olamadım. Varsa hatamız affola.

Merhaba
Ek dosyayı inceleyin
http://www.upturkey.com/download.php?file=814ornekk.xlsm

 Private Sub CommandButton1_Click()
i = Cells(Rows.Count, 1).End(xlUp).Row
For a = 2 To i - 1
For b = i To a + 1 Step -1
If Trim(Cells(a, 1).Value) = Trim(Cells(b, 1).Value) Then
Range(Cells(a, Cells(a, Columns.Count).End(xlToLeft).Column + 1), Cells(a, Cells(a, Columns.Count).End(xlToLeft).Column + 6)).Value = _
Range("b" & b & ":g" & b).Value
Rows(b).EntireRow.Delete
i = i - 1
End If: Next: Next
End Sub

 

[hayalmeyal]

Çok teşekkür ederim. birçok yerde kullanılabilecek çok işlevsel bir çalışma oldu.
mükerrer satırlardaki verileri bularak sütunlara ekledikten sonra o satırları da siliyor.
elinize emeğinize sağlık. Herşey gönlünüzce olsun. Vesselam

izninizle birşey daha sorsam,
bu çalışmada, veriyi A sütununda arıyor, A sütununda bulduğu mükerrer veriyi, birden fazla kaydın ilk satırına yazıyor.

Tekrarlayan verinin arandığı A sütununu nasıl değiştirebilirim, Yani sütunu D yapıp, sadece D den sonraki sütunları yana almak istesem ne yapmam gerekir. (a-b-c Sütunlarına karışmamış olacak ve sabit veriler yanyana gelerek sütun kalabalığı olmayacak)
bu örnektir. Sorgu D olmayıp E-F de olabilir.

 

[PLİNT]

Tekrarlayan verinin arandığı A sütununu nasıl değiştirebilirim, Yani sütunu D yapıp, sadece D den sonraki sütunları yana almak istesem ne yapmam gerekir. (a-b-c Sütunlarına karışmamış olacak ve sabit veriler yanyana gelerek sütun kalabalığı olmayacak)
bu örnektir. Sorgu D olmayıp E-F de olabilir.

Merhaba
"E" sütunu olursa yukarıda sadece 2 satır kalır
"F" sütunu olursa yaşları aynı olan isimler taşınır.
Siz asıl kullanacağınız dosyanın olmasını istediğiniz şekliyle küçük bir örnek
eklermisiniz?

 

[hayalmeyal]

Merhaba
"E" sütunu olursa yukarıda sadece 2 satır kalır
"F" sütunu olursa yaşları aynı olan isimler taşınır.
Siz asıl kullanacağınız dosyanın olmasını istediğiniz şekliyle küçük bir örnek
eklermisiniz?

..

Öncelikle çok teşekkür ederim. İşimi hallettim. istediğim gibi çok da güzel oldu.
Bu şekilde çok fazla veri ile karşılaşıyorum. yaptığınız çalışma birçok kez çok faydalı olacak.

Şuanki sorum bu çalışma için değil, farklı çalışmalarda, sabit verilerin abc veya
daha fazla sütunda olduğu ve bu alanlar her satırda aynı olduğu taşınmasına gerek olmadığı durumlarda;
verdiğiniz kod ile; bu sütunları farklı bir yere taşıdıktan sonra, kodu çalıştırıp, tekrar düşeyara ile yanlarına yazma gereği olacak;

Bunu yapmadan, kodun baz alacağı sütunu ben belirleyemez miyim?

 

[PLİNT]

..
Şuanki sorum bu çalışma için değil, farklı çalışmalarda, sabit verilerin abc veya
daha fazla sütunda olduğu ve bu alanlar her satırda aynı olduğu taşınmasına gerek olmadığı durumlarda;
verdiğiniz kod ile; bu sütunları farklı bir yere taşıdıktan sonra, kodu çalıştırıp, tekrar düşeyara ile yanlarına yazma gereği olacak;

Bunu yapmadan, kodun baz alacağı sütunu ben belirleyemez miyim?

Merhaba
Bu şeklin işinize yarayacağını umarım;
Veri bulunan herhangi bir sütun veya bir hücre seçerek (butonda) bir deneyin.

 Private Sub CommandButton1_Click()
Dim x, i As Long
x = Selection.Column
i = Cells(Rows.Count, x).End(xlUp).Row
If i <> 1 Then
For a = 2 To i - 1
For b = i To a + 1 Step -1
If Trim(Cells(a, x).Value) = Trim(Cells(b, x).Value) Then
Range(Cells(a, Cells(a, Columns.Count).End(xlToLeft).Column + 1), Cells(a, Cells(a, Columns.Count).End(xlToLeft).Column _
+ Cells(b, Columns.Count).End(xlToLeft).Column - x)).Value = _
Range(Cells(b, x + 1), Cells(b, Cells(b, Columns.Count).End(xlToLeft).Column)).Value
Rows(b).EntireRow.Delete  [COLOR="Red"]'SATIRI SİL[/COLOR]
i = i - 1    [COLOR="Red"] 'DÖNGÜDEN EKSİLT[/COLOR]
End If: Next: Next
End If
End Sub

 

[hayalmeyal]

Gayet güzel bir çalışma oldu. Problemsiz bir şekilde çalışıyor. Bu kod benim demirbaş formullerimden olacak
Çok saolun. Allah yar ve yardımcınız olsun.