• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Birden fazla hücreyi tek hücrede alt alta birleştirme.

Y

ydrkdrs

Katılım
15 Haziran 2016
Mesajlar
7
Excel Vers. ve Dili
2013
Herkese iyi çalışmalar.
Avukatlık yapıyorum ve İcra programımızdan alınan raporu düzenlerken bir sorun yaşıyorum. Kısaca anlatayım.
Program birden fazla borçlu varsa her birine ayrı bir hücre ayırıyor. Fakat alacaklı tek olduğunda alacaklıyı da iki ayrı hücreyi birleştirerek tek hücrede karşıma çıkarıyor. Bu listede 400 adet dosyayı barındırdığında, isme göre, Müdürlük veya bir başka kıstasa göre sıralama ihtiyacı doğuyor ve sorun da orada yaşanıyor. Çünkü excell birleşmiş hücre olduğundan sıralama yaptırmıyor. Bana lazım olan her sütunun birer hücrede olması, eğer birden fazla borçlu varsa bunu tek hücrede ama alt alta (Enter edilmiş gibi)göstermesi.
Böylelikle 300 dosyayı sıralama ve süzme yapıp çıktı alacağım. Yardım eden olursa sevinirim. Bir ricam da makro düzeyde yardım olmaması. Çünkü yapamayacağımı düşünüyorum.
 
Son düzenleme:
 
Merhaba,

Tag'daki kodu kullanabilirsiniz.

Kod: 
Sub duzenle()
Cells.UnMerge
son = Cells(Rows.Count, "a").End(3).Row + 1
Range("a1:f" & son).SpecialCells(xlCellTypeBlanks) = "=R[-1]C"
End Sub
 
Makro kullanmadan'da yapabilirsiniz.

1-Tüm hücreleri seçin ve Birleştir ve Ortala'ya tıklayın bütün birleştirilmiş hücreler çözülsün.

2-Veri olan alanı seçin sırası ile F5 >Özel >Boşluklar >Tamam >=A2 > CTRL+ENTER
 
Sayın KUVARİ;
Yazdıkların için teşekkürler ama beceremedim.
Listenin bir kısmını ekte seçtim. Yapmak istediğim önce icra Müdürlüğü, sonra dosya numarasına göre sıralamak.
Karşılaştığım sorunlar
1-) Bazı hücreler birleştiği için sıralama yapmıy.
2-) Dosya numaraları yıl/numara şeklinde olduğundan bir bütün olarak algılayıp 2015/91 nolu dosyayı 2018/12125 nolu dosyanın altına atıyor. Excel ilk beş karakter aynı olduğundan 6. karakterlere bakıyor ve (1) olanı üste atıyor. Bunu önce verileri (/) kıstası ile ayırıp sıralayıp tekrar birleştiriyorum.
Yardım ederseniz sevinirim. Profesyonel kullanıcı olmadığımdan ayrıntılı yardım ederseniz iki kat mutlu olurum.
http://s5.dosya.tc/server2/j4g9p2/takip-raporu-201606200727.xlsx.html
 
Son düzenleme:
Merhaba.

Kanaatim o ki, sıralama, filtreleme gibi işlemler için en kullanışlı yöntem hücreleri birleştirmek yerine
tam eksine birleştirmeleri iptal etmek ve oluşan boş hücrelere de bir üst hücre değerini yazdırmak diye düşünüyorum.
Tabi tercih sizin. Denemenizi öneririm.

Sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçtiğinizde açılan VBA ekranının sağa tarafındaki boş alana
aşağıdaki kod'u yapıştırın ve üst taraftaki RUN (çalıştır) düğmesine tıklayarak kod'u çalıştırın.
.
Kod: 
[FONT="Arial Narrow"]Sub BİRLEŞTİRME_İPTAL_TAMAMLA()
Range("A:I").UnMerge
    For satır = 2 To [D65536].End(3).Row
        For sütun = 1 To 8
            If Cells(satır, sütun) = "" Then Cells(satır, sütun) = Cells(satır - 1, sütun)
        Next
    Next
MsgBox "İşlem Tamamlandı."
End Sub[/FONT]
 
Son düzenleme:
Alternatif;

Ekteki örnek dosyayı inceleyiniz.
 

Ekli dosyalar

Üstad teşekkür ederim tavsiyen için. Fakat tavsiyene göre kodu yapıştırdığımda örneğin bir satırda 5 borçlu varsa diğer sütunlarda 4 boşluk var demektir ve formülle doldurduğumda 5 tane aynı dosya numarasından ekliyor (Ekte sarı ile boyalı). O durumda aşağıdaki gibi bir görüntü oluyor ki bu da benim 400-500 dosya için alacağım listede ciddi kalabalık demek. Başka önerin varsa sevinirim.
https://yadi.sk/i/HiMj4syFshoPn
 
Tekrar merhaba.

İstediğiniz şeyi aşağıdaki kod sağlayacaktır.
Belgeniz açıkken alt taraftan sayfa adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan VBA ekranının sağ tarafındaki boş alana aşağıdaki kod'u yapıştırın ve çalıştırın.
.
Kod: 
[FONT="Arial Narrow"][B]Sub BİRLEŞTİR()[/B]
Columns("G:G").Insert Shift:=xlToRight
Cells(1, 7) = 1
With Range("G2:G" & [D65536].End(3).Row)
    .Formula = "=IF(A2="""",G1,G1+1)"
    .Value = .Value
End With
For satır = 2 To WorksheetFunction.Max(Range("G:G"))
    ilk = WorksheetFunction.Match(satır, Range("G:G"), 0)
    son = WorksheetFunction.CountIf(Range("G:G"), satır) + ilk - 1
        For değer = ilk To son
            metind = metind & Chr(10) & Cells(değer, 4)
        Next
    Cells(ilk, 4) = Mid(metind, 2, Len(metind))
metind = ""
Next
Cells.UnMerge
For sat = [D65536].End(3).Row To 2 Step -1
    If Cells(sat, 1) = "" Then Rows(sat & ":" & sat).Delete Shift:=xlUp
Next
Columns("G:G").Delete Shift:=xlToLeft: Columns("D:D").ColumnWidth = 42.14
Rows.AutoFit: Columns.AutoFit: MsgBox "İşlem Tamamlandı."
[B]End Sub[/B][/FONT]
 
Ekran görüntüsü veya gerçek belgenizin bir parçasını paylaşır mısınız?
Çünkü örnek belgeniz üzerinde denediğimde sorunla karşılaşmadım.

Tekrar denedim, sorun göremiyorum.
İşlemin uygulandığı belgeye buradan ulaşabilirsiniz.
.
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst