aynı parsele hissedar olanları aynı satırda birleştirme

[baron07]

ada parsel adı soyadı baba adı tc kimlik adresi

101 20 ahmet durmuş 50111111111 gazi
101 20 mehmet ali 25111111111 istiklal
101 20 ali seyit 40111111111 yeni
101 20 veli ali 35111111111 pazarcı
101 20 durmuş seyit 45111111111 cumhuriyet


aynı ada parsele hissedar olan kişilere ait ad soyad,baba adı,tc kimlik ve adres bilgilerini tek bir hücrede birleştirmek istiyorum
liste bayağı kalabalık örnek hazırladım bunu.
Örneğin "G2" hücresinde bir formülle birleştirmek istiyorum

Bana yardımcı olursanız memnun olurum

 

[YUSUF44]

Yanlış anlamazsanız eğer neden böyle bir şeye ihtiyaç duyduğunuzu sorabilir miyim? Excelde farklı bilgilerin aynı hücrelere yazılması iyi bir uygulama değildir çünkü. Örneğin bu listenizde bir kişinin hissedar olduğu arazileri süzmek isteseniz süzemezsiniz.

Sorunuzun cevabı içinse örnek bir dosya hazırlayıp dosya yükleme sitelerinden birine (google drive, dosya.tc gibi) yükleyip burda paylaşmanız iyi olur.

 

[baron07]

bu listeyi yapmaktaki gayem dava dilekçesi hazırlayacağım aynı parsele hissedar olanların davalı kısımda yer alacak bilgilerin ( ad soyad,baba adı,tc kimlik ve adres) bir arada bulunmasını istiyorum.
Örnek dosyam var yüklemeye çalışacağım.
teşekkür ederim ilginiz için.

 

[tahsinanarat]

a sütununda aynı olan hücreleri birleştirir

Option Explicit

Sub BİRLEŞTİR()
    Dim X As Long, BUL As Range, SAY As Long
    
    Columns("IV:IV").Delete
    Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("IV1"), Unique:=True
    
    For X = 2 To Range("IV65536").End(3).Row
        Set BUL = Range("A:A").Find(Cells(X, "IV"), LookAt:=xlWhole)
        If Not BUL Is Nothing Then
        SAY = WorksheetFunction.CountIf(Range("A:A"), Cells(X, "IV"))
        If SAY > 1 Then

        With Range("A" & BUL.Row & ":A" & BUL.Row + SAY - 1)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
             Application.DisplayAlerts = False
            .MergeCells = True
             Application.DisplayAlerts = True
        End With
        With Range("B" & BUL.Row & ":B" & BUL.Row + SAY - 1)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
             Application.DisplayAlerts = False
            .MergeCells = True
             Application.DisplayAlerts = True
        End With

        End If
        End If
    Next

    Columns("IV:IV").Delete

    Set BUL = Nothing

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub