Hücrelerdeki Verileri Başka Bir Hücrede Altalta Birleştirmek

[baydeniro]

Merhaba Arkadaşlar
A sütununda bulunan hücrelerdeki verileri, B sütunundan ortak işarete göre C sütununda aynı hücre içinde ama alt alta gelecek şekilde birleştirmek mümkün müdür ?
Formül veya makro ile

 

[kulomer46]

Merhaba

Dosyanız Ek 'tedir.

Selamlar...

 

[baydeniro]

Merhaba

Dosyanız Ek 'tedir.

Selamlar...

Kulomer46 üstadım çok çok teşekkür ediyorum, harikulade bir çalışma olmuş. Elinize emeğinize sağlık. Bereketli günler dilerim, sağlıcakla kalın

 

[kulomer46]

Kulomer46 üstadım çok çok teşekkür ediyorum, harikulade bir çalışma olmuş. Elinize emeğinize sağlık. Bereketli günler dilerim, sağlıcakla kalın

Merhaba

Dosyayı biraz daha geliştirdim. Ek' tedir.

Selamlar...

 

[baydeniro]

Merhaba

Dosyayı biraz daha geliştirdim. Ek' tedir.

Selamlar...

ilginize çok teşekkür ederim üstadım. dışarı çıktım, ilk fırsatta 2.versiyonu inceleyip geri bildirim yapacağım

 

[Korhan Ayhan]

Alternatif;

Hızlı sonuç verir.

Option Explicit

Sub Verileri_Isarete_Gore_Birlestir()
    Dim S1 As Worksheet, Dizi As Object, Veri As Variant
    Dim Son As Long, X As Long, Say As Long, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("Sayfa1")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    S1.Range("C:C").Clear
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 1 Then Son = 2
    
    Veri = S1.Range("A1:B" & Son).Value
    
    ReDim Liste(1 To Son, 1 To 1)
    
    For X = LBound(Veri) To UBound(Veri)
        Say = Say + 1
        If Not Dizi.Exists(Veri(X, 2)) Then
            Dizi.Add Veri(X, 2), Say
            Liste(Say, 1) = Veri(X, 1)
        Else
            Liste(Dizi.Item(Veri(X, 2)), 1) = Liste(Dizi.Item(Veri(X, 2)), 1) & vbLf & Veri(X, 1)
        End If
    Next
    
    If Say > 0 Then Range("C1").Resize(UBound(Veri)) = Liste

    Set S1 = Nothing
    Set Dizi = Nothing

    MsgBox "Veri birleştirme işlemi tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[baydeniro]

Alternatif;

Hızlı sonuç verir.

Option Explicit

Sub Verileri_Isarete_Gore_Birlestir()
    Dim S1 As Worksheet, Dizi As Object, Veri As Variant
    Dim Son As Long, X As Long, Say As Long, Zaman As Double
   
    Zaman = Timer
   
    Set S1 = Sheets("Sayfa1")
    Set Dizi = CreateObject("Scripting.Dictionary")
   
    S1.Range("C:C").Clear
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    If Son = 1 Then Son = 2
   
    Veri = S1.Range("A1:B" & Son).Value
   
    ReDim Liste(1 To Son, 1 To 1)
   
    For X = LBound(Veri) To UBound(Veri)
        Say = Say + 1
        If Not Dizi.Exists(Veri(X, 2)) Then
            Dizi.Add Veri(X, 2), Say
            Liste(Say, 1) = Veri(X, 1)
        Else
            Liste(Dizi.Item(Veri(X, 2)), 1) = Liste(Dizi.Item(Veri(X, 2)), 1) & vbLf & Veri(X, 1)
        End If
    Next
   
    If Say > 0 Then Range("C1").Resize(UBound(Veri)) = Liste

    Set S1 = Nothing
    Set Dizi = Nothing

    MsgBox "Veri birleştirme işlemi tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Korhan Ayhan üstadım, desteğiniz için çok teşekkür ediyorum. Sade sonuçlar almak için harikulade bir seçenek olmuş. Sağlıcakla kalın