Hücre ile Aralığı birleştirme makrosu

[metini]

Merhaba arkadaşlar,

Elimdeki listede A sütunundaki 1. hücre ile E sütunundaki tüm verileri C sütununa birleştirmek istiyorum. Sonrasında A sütunundaki tüm satırları bu şekilde aşağı doğru birleştirmek istiyorum. Yardımcı olabilecek var mı acaba ?
Ben şöyle denedim fakat istediğim sonucu alamadım.

Sub birlestir()
For a = 1 To Cells(65536, 1).End(xlUp).Row

Cells(a, 3) = Cells(a, 1) & Cells(a, 5)


Next
End Sub

http://imgur.com/a/Ste6nxz

http://imgur.com/a/pAuD8X7

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Birlestir()
    Dim Son As Long, Veri As Variant, X As Long, Kriter As Variant, Say As Long, Zaman As Double
    
    Zaman = Timer
    
    Range("C2:C" & Rows.Count).ClearContents
    
    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:A" & Son).Value
    
    Kriter = Application.Transpose(Range("E2:E" & Cells(Rows.Count, 5).End(3).Row).Value)
    
    ReDim Liste(1 To Son, 1 To 1)
    
    For X = LBound(Veri) To UBound(Veri)
        Say = Say + 1
        Liste(Say, 1) = Veri(X, 1) & Join(Kriter, "")
    Next
    
    Range("C2").Resize(Say, 1) = Liste
    Columns.AutoFit
    
    MsgBox "Birleştirme işlemi tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[metini]

İstediğim sonucu alamadım maalesef. Sizin gönderdiğiniz makro tek hücreye yazdı ben alt alta bir döngü istiyorum aslında A2 hücresini E2:33 arasına birleştirip sonra A3 e geçmesi gerekiyor.

http://imgur.com/wE7zbwW

 

[Korhan Ayhan]

Mümkün değil... Deneyerek kodu paylaştım.

 

[metini]

Mümkünse şuradan deneyebilir misiniz? Ben makroyu çalıştırdığımda ekran görüntüsündeki gibi sonuç verdi.
testv2.xlsx - 10 KB

 

[Korhan Ayhan]

Doğru dediğiniz şekilde birleştiriyor. İlk mesajınızda A2 ile E sütunundaki tüm veriler birleşmeyecek mi? Sizin ilk mesajınızdaki resimde yazdığınız formül bu şekildeydi.

 

[metini]

Doğru dediğiniz şekilde birleştiriyor. İlk mesajınızda A2 ile E sütunundaki tüm veriler birleşmeyecek mi? Sizin ilk mesajınızdaki resimde yazdığınız formül bu şekildeydi.

Orda anlatmak istediğim aslında 2.resimdeki olaydı. A2 ile E sütunundaki tüm verileri alt alta tek tek birleştirip sonrasında A3 e geçmek, A4,A5,A6 hepsinin tek tek E sütunundaki 33 satır ile birleştirmek.

 

[Korhan Ayhan]

Tamam şimdi daha net anlaşıldı...

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Birlestir()
    Dim Son As Long, Veri As Variant, X As Long, Y As Long, Kriter As Variant, Say As Long, Zaman As Double
    
    Zaman = Timer
    
    Range("C2:C" & Rows.Count).ClearContents
    
    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:A" & Son).Value
    
    Kriter = Range("E2:E" & Cells(Rows.Count, 5).End(3).Row).Value
    
    ReDim Liste(1 To Son * UBound(Kriter), 1 To 1)
    
    For X = LBound(Veri) To UBound(Veri)
        For Y = LBound(Kriter) To UBound(Kriter)
            Say = Say + 1
            Liste(Say, 1) = Veri(X, 1) & Kriter(Y, 1)
        Next
    Next
    
    Range("C2").Resize(Say, 1) = Liste
    Columns.AutoFit
    
    MsgBox "Birleştirme işlemi tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[metini]

Deneyiniz.

Option Explicit

Sub Birlestir()
    Dim Son As Long, Veri As Variant, X As Long, Y As Long, Kriter As Variant, Say As Long, Zaman As Double
   
    Zaman = Timer
   
    Range("C2:C" & Rows.Count).ClearContents
   
    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:A" & Son).Value
   
    Kriter = Range("E2:E" & Cells(Rows.Count, 5).End(3).Row).Value
   
    ReDim Liste(1 To Son * UBound(Kriter), 1 To 1)
   
    For X = LBound(Veri) To UBound(Veri)
        For Y = LBound(Kriter) To UBound(Kriter)
            Say = Say + 1
            Liste(Say, 1) = Veri(X, 1) & Kriter(Y, 1)
        Next
    Next
   
    Range("C2").Resize(Say, 1) = Liste
    Columns.AutoFit
   
    MsgBox "Birleştirme işlemi tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Evet buydu istediğim Korhan Bey, elinize emeğinize sağlık çok teşekkür ederim. Bunu inceleyerek öğrenmeye çalışacağım.