Alt alta veri birleştirme

[ikikan]

Arkadaşlar açaba şöyle bir makro varmıdır.

A, B, C, D, E, ... sütunlarındaki alt alta olan verileri

bu sutunların 1 satrında olan hücrede birleştire bilirmiyiz?

 

[Necdet]

Merhaba,

Makro olmaz, makro yazılır.

Örnek dosyanızı ekleyin yardımcı olacak arkadaş(lar) çıkacaktır.

 

[ikikan]

Merhaba,

Makro olmaz, makro yazılır.

Örnek dosyanızı ekleyin yardımcı olacak arkadaş(lar) çıkacaktır.

Örnek dosya ektedir bu şekil bir birleştirme makro ile yazıla bilirmi?

 

[mancubus]

veriler F1'den başlıyor değil mi?

Sub hucredeki_satirlari_hucrelere_bol()

    Dim i As Long
    
    For i = 6 To Range("F1").End(xlToRight).Column
        Cells(1, i).Offset(1).Resize(UBound(Split(Cells(1, i), vbLf)) + 1) = Application.Transpose(Split(Cells(1, i), vbLf))
    Next i

End Sub

 

[ikikan]

veriler F1'den başlıyor değil mi?

Sub hucredeki_satirlari_hucrelere_bol()

    Dim i As Long
    
    For i = 6 To Range("F1").End(xlToRight).Column
        Cells(1, i).Offset(1).Resize(UBound(Split(Cells(1, i), vbLf)) + 1) = Application.Transpose(Split(Cells(1, i), vbLf))
    Next i

End Sub

hata veriyor benmi uygulayamadım acaba!

 

[mancubus]

veriler F1'den başlıyor değil mi?

bunu özellikle sormuştum.

birinci yüklenen dosya ile 2. yüklenen dosya farklı.

2. dosyada veriler 1. satırda değil. bu nedenle hata verecek.
bölmek istediğiniz verileri F1'den başlayarak 1. satıra kopyalayıp deneyin.
veya kodda verinin bulunduğu ilk hücrenin adresini değiştirin.


eski verinin üzerine yazmak (bir anlamda birleşik olan veriyi silmek) isterseniz aşağıdaki kodu kullanabilirsiniz.
.Offset(1) kısmı silinerek, ilk eklediğim koddaki hücrenin bir satır aşağısından işlem yapılması önlenmiştir.

Sub hucredeki_satirlari_hucrelere_bol()

    Dim i As Long
    
    For i = 6 To Range("F1").End(xlToRight).Column
        Cells(1, i).Resize(UBound(Split(Cells(1, i), vbLf)) + 1) = Application.Transpose(Split(Cells(1, i), vbLf))
    Next i

End Sub

diğer husus... 2. dosyadaki veriler zaten zaten bölünmüşler...

 

[mancubus]

işlem yapılacak hücrelerin arasında boşluk olma ihtimaline karşılık aşağıdaki gibi bir düzeltme daha sağlıklı olacaktır:

Sub hucredeki_satirlari_hucrelere_bol()

    Dim i As Long
    
[COLOR="Red"]    On Error Resume Next[/COLOR]
    For i = 6 To Cells(1, Columns.Count).End(xlTo[COLOR="red"]Left[/COLOR].Column
        Cells(1, i).Offset(1).Resize(UBound(Split(Cells(1, i), vbLf)) + 1) = Application.Transpose(Split(Cells(1, i), vbLf))
    Next i

End Sub

 

[ikikan]

Bir yanlışlık var ben bölmek istemiyorum f1 hücresinde de f2 den itibaren tüm dolu hücrelerdeki verileri birleştirmek istiyorum örnek verecek olursak aşadaki kod bir sütunu bir hucrede istediğim şekilde birleştiriyor ben bunu makro ile 25 sütunda yapabilirmiyim?

'For Each hucre In shf1.Range("C2:C" & ss2)
'If UCase(hucre.Value) = Empty Then
      'sonuc2 = sonuc2 & hucre.Value
      'Else
      'sonuc2 = sonuc2 & hucre.Value & Chr(10)
      'End If
'Next hucre

'shf1.Range("B3").Value = sonuc2

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz.

Sub Birlestir()
    Dim Ver As Range, x As Long, Sonuc As String
    
    For Each Veri In Range("F1:BO1")
        For x = 2 To Cells(Rows.Count, Veri.Column).End(3).Row
            If Sonuc = "" Then
                Sonuc = Cells(x, Veri.Column)
            Else
                Sonuc = Sonuc & vbLf & Cells(x, Veri.Column)
            End If
        Next
        Cells(1, Veri.Column) = Sonuc
        Sonuc = ""
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[mancubus]

pardon. yanlış anlamışım...

Sub hucreleri_tek_hucrede_birlestir()

    Dim i As Long
    
    For i = 6 To Cells.Find("*", , , , xlByColumns, xlPrevious).Column
        Cells(1, i) = Join(Application.Transpose(Range(Cells(2, i), Cells(Cells(Rows.Count, i).End(xlUp).Row, i))), vbLf)
    Next i

End Sub

 

[ikikan]

Teşekürler iki makroda işe yarıyor ..

 

[mancubus]

rica ederim.