hucureleri tek sutunda birleştirme

[neco_can]

merhabalar sevgili dostlar verileri tek sutunda alt alta birleştirmem gerekmekte ekteki ekran görüntüsünü derdimi daha net anlatır sanırım teşekkürler.

 

[neco_can]

excel profesorlerının yardımı beklenmekte

 

[Murat OSMA]

Stajerden yardım almak ister misiniz ?

 

[neco_can]

Yardımın her türlüsüne kapım açık dostum.

 

[Murat OSMA]

Dosya gönder o hâlde dostum.

 

[neco_can]

kardesım dosyaları ozelden gonderdım sana. 50mb fazla oldugu ıcın buraya yukleyemedım

 

[Murat OSMA]

O kadar büyük boyutta dosya yollamanıza gerek yok. Zaten indirme kotam dolduğu için o dosyayı indiremedim.

Dosyanızdaki veriler resimdeki kadar olsa kâfidir..
Sadece ne yapmak istediğinizi net bir şekilde dosya içerisinde anlatan küçük boyutta bir dosya gönderin.

 

[RedStar]

Stajerden yardım almak ister misiniz ?

Murat hocam siz üstadsınız.

 

[Murat OSMA]

Estağfurullah Cem Bey, üstad olmak kim.. biz kimiz......
Yine de bu sıfatı lâyık gördüğünüz için teşekkürler, hoşça kalın !

 

[neco_can]

Üstat tekrar merhaba, http://s3.dosya.tc/server11/Ui00qX/Kitap1.xlsx.html
linke dosyanın bir parçasını gönderdim. birleşmiş sutunlardaki verilerin tek sutunda birleştirmesini istiyorum.shilt 1 deki verilerin shilt 2 deki gibi olmasını istiyorum

 

[neco_can]

dostlar yardımlarınızı beklıyorum bır turlu aşamadım sorunu

 

[Murat OSMA]

Birazdan yardım geliyor.

 

[Murat OSMA]

Biraz zaman alıyor ama ilk aklıma gelen yöntem bu şekilde;

Sub Birleştir()
    Application.ScreenUpdating = False
    Dim i As Long, a As Long
    Dim basla, bitir, süre
    basla = Timer
    Cells.UnMerge
    For i = Range("a65536").End(3).Row To 2 Step -1
        If Cells(i, 1) = "" Then
            Rows(i).Delete
        End If
    For a = Cells(1, Columns.Count).End(1).Column To 2 Step -1
        If Cells(i, a) = "" Then
            Cells(i, a).Delete Shift:=xlShiftToLeft
        End If
    Next a
    Next i
    Columns.AutoFit
    Application.ScreenUpdating = False
    bitir = Timer
    süre = Format(bitir - basla, "Fixed") & " sn."
    MsgBox süre
    i = Empty: a = Empty
End Sub

 

[neco_can]

Biraz zaman alıyor ama ilk aklıma gelen yöntem bu şekilde;

Sub Birleştir()
    Application.ScreenUpdating = False
    Dim i As Long, a As Long
    Dim basla, bitir, süre
    basla = Timer
    Cells.UnMerge
    For i = Range("a65536").End(3).Row To 2 Step -1
        If Cells(i, 1) = "" Then
            Rows(i).Delete
        End If
    For a = Cells(1, Columns.Count).End(1).Column To 2 Step -1
        If Cells(i, a) = "" Then
            Cells(i, a).Delete Shift:=xlShiftToLeft
        End If
    Next a
    Next i
    Columns.AutoFit
    Application.ScreenUpdating = False
    bitir = Timer
    süre = Format(bitir - basla, "Fixed") & " sn."
    MsgBox süre
    i = Empty: a = Empty
End Sub

size teşekkür edememiştim. Çok sağolun işimi gördü