Bir hücredeki veriye göre diğer hücredeki verileri yanyana yazdırma

[ocannn]

Sayın uzman arkadaşlar,
Ekte örneği yer alan ve daha uzun veriye sahip bir dosyam var. Bu dosyada BARKOD1 her değiştiğinde MÜŞTERİ KODLARI sütunundaki BARKOD1 ile ilgili değerlerin tek bir hücreye birleştirilip, virgül ile ayrılmış olarak yazılmasına ihtiyacım var. Aynı zamanda BARKOD1'in eğiştiği her ilk satırındaki veriler de Sayfa2'ye aktarılacak.
(ekteki dosyada Sayfa1 asıl veri, Sayfa2 ihtiyaç duyduğum sonuçtur).

Ben csvrange diye bir fonksyon kullanıyorum. Ancak bu fonksyonu kullanmam için önce süzmem sonra kopyala yapıştır gibi işlemler gerekiyor, liste uzun veri de çok olunca çok vakit kaybı...
Bu konuya makro ile bir çözüm bulabilir miyiz?

Kullandığım fonksyon:
Function csvRange(myRange As Range)
Dim csvRangeOutput
For Each entry In myRange
If Not IsEmpty(entry.Value) Then
csvRangeOutput = csvRangeOutput & entry.Value & ","
End If
Next
csvRange = Left(csvRangeOutput, Len(csvRangeOutput) - 1)
End Function

 

[apocalyt]

merhaba.
aşağıdaki kodu bir module kopyalayıp çalıştırın..

Sub daylight()
Application.ScreenUpdating = False
Z = Sheets(1).[a10000].End(3).Row
Sheets(2).Range("a210000").ClearContents
For x = 2 To Sheets(1).[a10000].End(3).Row

sen = Sheets(1).Cells(x, 1)
For y = 1 + x To Sheets(1).[a10000].End(3).Row
If Sheets(1).Cells(x, "d") = Sheets(1).Cells(y, "d") Then
sen = sen & "," & Sheets(1).Cells(y, "a")
ben = ben + 1
If y = Z Then GoTo gel
Else
gel:
Sheets(2).Cells(Sheets(2).[a10000].End(3).Row + 1, "a") = sen
Sheets(1).Range("b" & x & "" & x).Copy
Sheets(2).Range("b" & Sheets(2).[b10000].End(3).Row + 1).PasteSpecial
Exit For
End If
Next y
x = x + ben
sen = ""
ben = 0
Next x
Application.ScreenUpdating = True
End Sub

 

[apocalyt]

gülücük olan yerlerde ": o" şeklinde..ancak boşluk bırakmayınız : ile o arasında.

 

[ocannn]

Sayın apocalyt,
Emeğiniz için teşekkür ederim, ancak küçük bir sorun var. Örnek dosyasında son BARKOD1 311 olmasına rağmen kopyalarken 310'da kalıyor. Bir de kodu orjinal dosya verilerine uyguladığımda Sayfa2 içeriğini siliyor ama verileri aktarmıyor. Sorun ne olabilir?

 

[apocalyt]

yukarıdaki mesajımda gönderdiğim kodu yeniledim..310 da artık kalmıcak..şu an sorunsuz çalışıyo..ancak sizin dosyanızda sorun neyden kaynaklanıyo onu dosyayı görmeden sölemem güç..

 

[ocannn]

Biraz uğraştım sorunu çözdüm. son satırı için 10000 olan değeri ben son verinin bulunduğu satır yapıyordum, bir fazlasını yapınca çalıştı.
TEkrar teşekkür ederim ancak şimdi de başka bir sorun çıkıyor. eğer tekrar eden BARKOD yoksa yani tek satırlık değer ise anlamsız bir değere dönüştürüyor, o da sanırım tek satır olunca da sonuna "," ekliyor o zamanda sayı gibi görüyor değeri, bu sorunu çözemedim.