Sütunları virgüllü satırlara dönüştürmek

Katılım
6 Ağustos 2007
Mesajlar
13
Excel Vers. ve Dili
MS Office 2003
Arkadaşlar Merhaba,
Ekte yolladığım excelde 2 sütun yer alıyor, bu sütunlardan ilki id niteliğinde. 2. sütunsa kategori bilgisi, istediğim ise id lere ait kategorileri aşağıya doğru değilde, virgülle ayrılmış biçimde yana doğru yazdırmak.
Eke bakabilirseniz ayrıntılı olarak resimleyerek anlattım.
Yardımlarınız için çok teşekkür ederim.
Saygılarımla,
Cihan
 

BG

Özel Üye
Katılım
5 Mayıs 2008
Mesajlar
1,378
Excel Vers. ve Dili
Office 2021 TR & EN
Merhaba

Sheet1 H1 hücresine aşağıdaki formülü kopyalayınız.

Örnektir.

=BİRLEŞTİR(B1;",";B2;",";B3;",";B4;",";B5;",";B6;",";B7;",";B8;",";B9;",";B10;",";B11;",";B12)
 
Katılım
6 Ağustos 2007
Mesajlar
13
Excel Vers. ve Dili
MS Office 2003
Sevgili brain, yanıtın için teşekkürler, ancak ben bunun makro ile çözüleceğini düşünüyorum, çünkü senin çözümün tek bir id için, ve her id nin kategori sayısı farklı...Yardımlarınızı bekliyorum...Teşekkürler, Cihan
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosyanız ekte.:cool:
Kod:
Sub IDNOLAR()
Dim i As Long, k As Range, sat As Long
Sheets("Sheet1").Select
Application.ScreenUpdating = False
Range("G1:H65536").ClearContents
For i = 1 To Cells(65536, "A").End(xlUp).Row
    Set k = Range("G1:G65536").Find(Cells(i, "A").Value)
    If k Is Nothing Then
        sat = sat + 1
        Cells(sat, "G").Value = Cells(i, "A").Value
        Cells(sat, "H").Value = Cells(i, "B").Value
        Else
        k.Offset(0, 1).Value = k.Offset(0, 1).Value & "," & " " & Cells(i, "B").Value
    End If
Next i
Set k = Nothing
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,680
Excel Vers. ve Dili
Excel 2019 Türkçe
Bir tane de benden olsun.
Kod:
Sub dd()
c = 1
    Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("g1"), Unique:=True
    [g1].Delete
    For i = 1 To [a65536].End(3).Row
        If Cells(i, 1) = Cells(c, "g") Then
            a = a & Cells(i, 2) & ", "
        End If
        Cells(c, "h") = Left(a, Len(a) - 2)
        If Cells(i, 1) <> Cells(i + 1, 1) Then c = c + 1: a = ""
    Next
End Sub
 
Katılım
6 Ağustos 2007
Mesajlar
13
Excel Vers. ve Dili
MS Office 2003
Arkada&#351;lar &#231;ok ama &#231;ok te&#351;ekk&#252;rler..
Excelwebtr.com &#231;&#246;zemedi&#287;i bir soru g&#246;remedim zaten.
Ne s&#246;ylesem az, &#231;ok te&#351;ekk&#252;rler...
Cihan
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,158
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Dikkatimi &#231;ekti&#287;i i&#231;in soruyorum; sn. prepositions'un &#246;rnek dosyas&#305;nda kodlar &#231;al&#305;&#351;t&#305;r&#305;ld&#305;&#287;&#305;nda, A sutununda tek olan say&#305;lar&#305;n kar&#351;&#305;l&#305;&#287;&#305;ndaki b sutunundaki bilgilerin sat&#305;r&#305; bo&#351; olarak geliyor,
oysa sn. Evren Gizlen'in ekli dosyas&#305;nda ise bo&#351; gelmiyor, neden olabilir ki, ben bulamad&#305;m
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,158
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
afedersiniz, h&#252;creler sa&#287;a yazl&#305; oldu&#287;u i&#231;in g&#246;rmemi&#351;im, &#351;imdi fark ettim, ellerinize sa&#287;l&#305;k. ar&#351;ivime al&#305;yorum
 
Üst