Yinelenen satırların yan hücresindeki metinleri tek satır olarak birleştirme

[sihirliayna]

Merhabalar. Aşağıdaki gibi bir listemiz mevcut toplamda 50.000 satır.
Bunlar bir faturadaki her bir ürünün kalem kalem listeleri, Biz aynı fatura numarasındaki bütün ürünleri aşağıdaki gibi birleştirmemiz gerekli.
Çok büyük dosya olduğundan tek tek birleştirmek çok zahmetli. Bunun için bize bir formül veya makro ile yardımcı olabilirmisiniz.

Toptan Satış Faturası	12.01.2022​	AYS LTD.ŞTİ.	RAM2022000000115	(M)	KAVURMA,	2,09 KG,
Toptan Satış Faturası	12.01.2022​	AYS LTD.ŞTİ.	RAM2022000000115	(M)	SUCUK,	1,84 KG,
Toptan Satış Faturası	12.01.2022​	AYS LTD.ŞTİ.	RAM2022000000115	(M)	500 GR MANTI,	10 ADET,
Toptan Satış Faturası	12.01.2022​	AYS LTD.ŞTİ.	RAM2022000000115	(M)	180 GR SUCUK,	6 ADET,
Toptan Satış Faturası	12.01.2022​	AYS LTD.ŞTİ.	RAM2022000000115	(M)	0,90 GR PASTIRMA,	15 ADET,
Toptan Satış Faturası	12.01.2022​	AYS LTD.ŞTİ.	RAM2022000000115	(M)	SUCUK,	50,542 KG,
					AŞAĞIDAKİ ŞEKİLDE BİRLEŞTİRİLECEK
Toptan Satış Faturası	12.01.2022​	AYS LTD.ŞTİ.	RAM2022000000115	(M)	KAVURMA,SUCUK,500 GR MANTI,180 GR SUCUK,0,90 GR PASTIRMA,SUCUK,	2,09 KG, 1,84 KG, 10 ADET, 6 ADET, 15 ADET, 50,542 KG,

​

 

[alicimri]

Eğer tablonuz A1 hücresinden başlıyor, ilk satır başlık ve A:E arası veriler örnek resminizdeki gibi aynı olanları alt alta sıralanmış ise

Sub birles()
For i = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
If Cells(i, 1) & Cells(i, 2) & Cells(i, 3) & Cells(i, 4) & Cells(i, 5) = Cells(i + 1, 1) & Cells(i + 1, 2) & Cells(i + 1, 3) & Cells(i + 1, 4) & Cells(i + 1, 5) Then
Cells(i + 1, 6).Value = Cells(i, 6).Value & " " & Cells(i + 1, 6).Value
Rows(i).Delete
End If
Next
End Sub

 

[ÖmerFaruk]

Örnek dosyanız olsa işler biraz kolay olacak. Forumda bolca benzer çalışma var. Ama kendinize uyarlayabileceğinizi sanmıyorum.
Siz mevcut dosyanızı ya da örnek bir parçasını paylaşırsanız onun üzerinden tam çözüm gelecektir.
Altın üye değilsiniz, harici paylaşım sitelerine yükleyip link paylaşabilirsiniz.

 

[alicimri]

makro hatalı işlem yapıyor.

Derken ne kast ediyorsunuz. Üsteki tabloyu alttaki tabloya dönüştürmüyor mu? Ben tekrar denedim, sorun çıkmadı.

 

[ÖmerFaruk]

50.000 civarında satırdan bahsediliyor.
Ve sanırım yüzlerce faturada yer alan her kalem ayrı satırlara girilmiş.
Arkadaş bunları birleştirmek istiyor

 

[alicimri]

50.000 civarında satırdan bahsediliyor.
Ve sanırım yüzlerce faturada yer alan her kalem ayrı satırlara girilmiş.
Arkadaş bunları birleştirmek istiyor

Tamam yukarıdaki kod baştan dört sütun aynı ise En alt satırdan yukarı ya doğru dediğiniz işlemi yapıyor,

 

[alicimri]

denemex.xlsm dosyasını indir - download

denemex.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

sadece firma isimlerini değiştirdim.

 

[sihirliayna]

denemex.xlsm dosyasını indir - download

denemex.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

sadece firma isimlerini değiştirdim.

Merhabalar denemedosyasını indirdim.
Ürün İsimlerini birleştirme yapıyor. Ancak Ürün miktarlarının birleştirmesini yapmıyor.
Bakabilirmisiniz.

 

[alicimri]

Sadece 4. Sütundaki Fatura numarası kontrol ediyor.

Sub birles()
For i = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
If Cells(i, 4) = Cells(i + 1, 4) Then
Cells(i + 1, 5).Value = Cells(i, 5).Value & " " & Cells(i + 1, 5).Value
Cells(i + 1, 6).Value = Cells(i, 6).Value & " " & Cells(i + 1, 6).Value
Rows(i).Delete
End If
Next
End Sub

 

[alicimri]

#7 mesajdaki dosyayı değiştirdim.

 

[sihirliayna]

Üstadım öncelikle çok teşekkür ederim. Sorunumu çözdüğün için. Liste formatına göre ayarladıktan sonra Makro çok güzel çalıştı ve toplam 57.000 satır 5.000 civarı satıra düştü ve liste tam istediğim gibi oldu.
Bana vaktini ayırıp yardımcı olduğun için çok minnettarım. Bu nedenle adresini özelden yazabilirsen küçük bir hediye göndermek istiyorum.