• FORUMU MOBİL UYGULAMADAN TAKİP EDİN

    Forumu isteyen üyelerimiz Tapatalk (Harici bir hizmet) üzerinden mobil uygulamadan takip edebilirler.
    iOS için : https://itunes.apple.com/app/id307880732?mt=8
    Android için : https://play.google.com/store/apps/details?id=com.quoord.tapatalkpro.activity
    adreslerinden indirebilirsiniz.

    Bir iki haftaya da foruma özel kendi uygulamamız yayında olacak.
ALTIN ÜYELİK Hakkında Bilgi
-----------------------

Aynı sütunu birleştirip verileri yanyana dizmek

Katılım
4 Aralık 2018
Mesajlar
3
Beğeniler
0
Excel Vers. ve Dili
2007
#1
Aslında buraya başlık açmak istemezdim ama google da bu konuyu nasıl arayacağımı bile bilemedim, ne türkçe ne ingilizce. Aslında yapmak istediğim şey çok basit gibi görünüyor ama bir türlü basit bir çözüm bulamadım. Yardımcı olursanız sevinirim.

Bir sütundaki aynı verileri içeren satırları birleştiriyor ve o sütunun yanındaki sütunda bulunan verileri yanyana olacak şekilde birleştirilen verinin yanına yazıyoruz.
Zaten aşağıdaki resimlerden kolayca anlaşılır.

Şu haldeki verileri


Şu hale getirmek istiyorum :


Yardımcı olabilir misiniz
 
Katılım
9 Mart 2005
Mesajlar
2,251
Beğeniler
1
Excel Vers. ve Dili
Excel 2003-tr
#4
Makro ile yapmak isterseniz;

Kod:
Sub satirlardakiVerileriSutunlaraAktar()

    Set dic = CreateObject("Scripting.Dictionary")
    veriler = Range("a1:B" & Cells(Rows.Count, 1).End(3).Row).Value

    With dic
        For i = 1 To UBound(veriler)
            anahtar = veriler(i, 1)
            veri = veriler(i, 2)
            If Not .exists(anahtar) Then
                .Add anahtar, anahtar & "|" & veri & "|"
            Else
                .Item(anahtar) = .Item(anahtar) & veri & "|"
            End If
        Next i
        liste = .items
    End With

    Range("$D$1:" & Cells(Rows.Count, Columns.Count).Address).ClearContents

    Set Rng = Range("D1")

    For Each lst In liste
        ver = Split(Left(lst, Len(lst) - 1), "|")
        Rng.Resize(, UBound(ver) + 1).Value = ver
        Set Rng = Rng.Offset(1)
    Next

    Set dic = Nothing
    Set Rng = Nothing

End Sub
 
Katılım
4 Aralık 2018
Mesajlar
3
Beğeniler
0
Excel Vers. ve Dili
2007
#5
Bu çok iyi oldu hocam. Excel e çok hakim olmadığım için Macro ile daha kolay oldu. Çalıştır dedim zaten iş bitti (y)
 
Katılım
21 Temmuz 2005
Mesajlar
7,424
Beğeniler
13
Excel Vers. ve Dili
İş:Excel 2013-Türkçe
Ev:Excel 2010-Türkçe
#6
Alternatif

Kod:
Sub sırala()
Dim d As Object, u(), c()
Dim a, e, ra As Long, i As Long
Set d = CreateObject("scripting.dictionary")
a = Range("A1").CurrentRegion
ra = UBound(a, 1)
ReDim u(1 To ra, 1 To 2), c(1 To ra + 1)
For i = 1 To ra
    e = a(i, 1)
    If Not d.exists(e) Then
        d(e) = d.Count + 1
        u(d(e), 1) = e
        u(d(e), 2) = a(i, 2)
        c(d(e)) = 2
    Else
        c(d(e)) = c(d(e)) + 1
        If c(d(e)) > UBound(u, 2) Then _
            ReDim Preserve u(1 To ra, 1 To c(d(e)))
        u(d(e), c(d(e))) = a(i, 2)
    End If
Next i
Cells(2, 4).Resize(d.Count, UBound(u, 2)) = u
End Sub
 
Katılım
21 Temmuz 2005
Mesajlar
7,424
Beğeniler
13
Excel Vers. ve Dili
İş:Excel 2013-Türkçe
Ev:Excel 2010-Türkçe
#7
Formülle çözüm ise

D2 hücresine

Kod:
=EĞERHATA(İNDİS($A$2:$A$20;KÜÇÜK(EĞER(SIKLIK(EĞER($A$2:$A$20<>"";KAÇINCI($A$2:$A$20;$A$2:$A$20;0));SATIR($A$2:$A$20)-SATIR($A$2)+1);SATIR($A$2:$A$20)-SATIR($A$2)+1);SATIRSAY($D$2:$D2)));"")
yazıp CTRL+SHIFT+ENTER tuşlarına basarak dizi formülü oluşturup aşağı doğru çekiniz.

E2 hücresine de

Kod:
=EĞER(D2="";"";EĞERHATA(İNDİS($B$2:$B$20;KÜÇÜK(EĞER($A$2:$A$20=$D2;SATIR($A$2:$A$20)-SATIR($A$2)+1);SÜTUNSAY($E2:E2)));""))
yazıp CTRL+SHIFT+ENTER tuşlarına basarak dizi formülü oluşturup sağa ve aşağı doğru çekerek doldurunuz.
 
Katılım
12 Mart 2011
Mesajlar
1
Beğeniler
0
Excel Vers. ve Dili
ms office2010
#8
merhaba
yukarıdaki ilk makro çalışıyor
ancak benim çalıştığım veri biraz fazla
sütunda 225.000 veri var 160 değişik ürün var
375 sütun yazıyor kalanını yazmıyor
bana yaklaşık 1500 sütun lazım
ne yapmalıyım
teşekkürler
 
Üst