Sutunda bulunan aynı değerleri satıra yazmak

[magduruz]

Merhaba,
bu sorunuma yardımcı olabilirseniz beni binlerce satırlık excel dosyalarından kurtarmış olursunuz o yüzden ilgilenen kişilere şimdiden teşekkür ediyorum.

sorun şu ki örnek tablodada gösterdiğim gibi sutunda bulunan aynı isimli içeriklerin yanında bulunan adres bilgilerini yanındaki sutunlara dizecek şekilde bir formül makro vs artık nasıl çözülebiliyorsa yapılması. bir nevi işlemi tersine çevir formülü gibi ama daha karmaşık olduğundan araştırmama rağmen yapamadım

örnek koyduğum tabloda olması gereken şeklide belirttim çünkü yazarak anlatmak biraz zor oluyor.

 

[Ömer]

Merhaba,

İlk tabloda Adres verileri sadece B sütunun damı?

 

[magduruz]

evet bütün adresler b sutununda altalta duruyor ama onların a sutunundaki değere göre yan yana satır olarak ayarlamak gerek

 

[Ömer]

Veri sayınız fazla olduğunda makro ile yapmak daha mantıklı olacaktır. İstenen düzeni farklı bir sayfada makro yazılmasını hazırlayacağım.
Bu şekilde bir mahsuru yoktur sanırım.

Dilerseniz siz makro kullanmadan özet tabloyla da yapabilirsiniz.

 

[Ömer]

Ekteki dosyada, "özet_al" butonunu kullanın.

.

 

[magduruz]

görderdiğiniz haliyle elimdeki verileri girerek denedim işe yaradı ilginiz için çok teşekkür ederim

 

[magduruz]

Tekrar merhaba,
en son yaptığımız excelden sonra şöyle bir durum ortaya çıktı kullandığımız sistem en fazla 5 adresi alabiliyor sizden ricam 1 kişiye ait 5 adresten fazla olan verileri 5'li gruplar halinde bölebiliyor muyuz. yani 1 kişinin 15 adresi var bunların 15ninde yan yana olması yerine 3 tane 5li grup olarak ayırabilir miyiz

 

[Ömer]

Kodları aşağıdakilerle değiştirerek deneyin.

Sub Ozet_Birlestir()
 
    Dim d As Object, i As Long, sut As Integer, sat As Long
    Dim s, a1, a2, t, deg As String, j As Integer
 
    Set d = CreateObject("Scripting.Dictionary")
 
    Application.ScreenUpdating = False
    Sheets("veri").Select
    Sheets("ozet_makro").Cells.ClearContents
 
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        deg = Cells(i, "A")
        If Not d.exists(deg) Then
            s = Cells(i, "B")
            d.Add deg, s
        Else
           s = d.Item(deg)
           s = s & "|" & Cells(i, "B")
           d.Item(deg) = s
       End If
    Next i
 
    Sheets("ozet_makro").Select
    a1 = d.keys: a2 = d.items: sat = 1
    For i = 0 To d.Count - 1
        Cells(sat, "A") = a1(i)
        sut = 2
        t = Split(a2(i), "|")
        For j = 0 To UBound(t)
            If j Mod 5 = 0 And j <> 0 Then
                sat = sat + 1: sut = 2
                [COLOR=darkolivegreen]'Cells(sat, "A") = Cells(sat - 1, "A")[/COLOR]
            End If
            Cells(sat, sut) = t(j)
            Cells(1, sut) = "Adresi"
            sut = sut + 1
        Next j
        sat = sat + 1
    Next i
 
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
 
End Sub

.

 

[magduruz]

tekrar teşekkür ederim