Hücre Birleştirme

[atilayildirim]

selamlar,

direkt konuya girmek gibi olacak ama: a1, a5, a9 ve son olarak a12 hücrelerinin dolu olduğunu düşünürsek (aradaki boş hücreler "EĞER" formülü ile boşaltıldı) a1-a4 hücreleri birleştirilip a1 değeri yazılacak, a5-a8 hücreleri birleştirilip a5 hücresinin değeri yazılacak a9-a11 birleştirilip a9 değeri yazılacak ve a12 ile bitecek.

forumda bulabildiğim makrolar formül içeren hücrelerde istediğim şekilde çalışmıyor o nedenle yeni bir konu açmak zorunda kaldım. aşağıdaki makroda değişiklik yapılark halledilebilir belki. ilginize teşekkürler.

Sub Merge_Yap()
SonSat = [B65536].End(3).Row
For i = 2 To [A65536].End(3).Row
j = Cells(i, "A").End(xlDown).Row
If j > SonSat Then
j = SonSat
Else
j = j - 1
End If

With Range(Cells(i, "A"), Cells(j, "A"))
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.MergeCells = True
End With
i = j
Next i
End Sub

 

[Serpily]

Bunu bir programın parçası olarak istemiyorsanız şu yöntemi önerebilirim.

a1 hücresine tıklayıp D sütununun son hücresine kadar seçin ve çapraz birleştir yapın. Seçimin ilk sütununu birleştirilen hücreye yazacaktır.

Bu arada Çapraz Birleştir'i Araçlar>Özelleştir>Komut>Biçim>Çapraz Birleştir den Araç Çubuğuna yerleştirebilirsiniz.

Eğer bu işinizi görmezse makroya da bakalım.

 

[atilayildirim]

selamlar

öncelikle ilginize teşekkür ederim serpily. dolu ve boş hücreler sabit olmadığı için bir makro ile çalışması lazım diye düşünüyorum (formül ile yapılabilceği ile ilgili forumda bişey bulamadım açıkçası.) bir de ben o makroyu daha önce aynı konu ile ilgili sorulmuş bir sorudan aldım.
http://www.excel.web.tr/showthread.php?t=39535&highlight=h%FCcre+birle%FEtirme istenilen şey aynı ancak
dediğim gibi burdaki makro, benim hücreler formülle boşaltıldığı için çalışmıyor.
ilginize teşekkürler.
saygılar.

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub Birlestir()
SonSatir = [A65536].End(3).Row
EskiSatirNo = 1
For i = 2 To SonSatir
    If Cells(i, "A") <> "" Then
        Range("A" & EskiSatirNo & ":A" & i - 1).Merge
        Range("A" & EskiSatirNo & ":A" & i - 1).VerticalAlignment = xlCenter
        EskiSatirNo = i
    End If
Next i
End Sub

 

[atilayildirim]

selamlar,

Necdet Bey çok teşekkür ederim. istediğim gibi oldu gerçekten.
saygılar.

 

[Necdet]

Güle güle kullanınız Atila Bey,

Aşağıdaki şekilde de yazılabildiğini biliniz.

Sub Birlestir()
SonSatir = [A65536].End(3).Row
EskiSatirNo = 1
For i = 2 To SonSatir
    If Cells(i, "A") <> "" Then
[COLOR=red]        Range("A" & EskiSatirNo & ":A" & i - 1).Select
        With Selection
            .MergeCells = True
            .VerticalAlignment = xlCenter
        End With
[/COLOR]        EskiSatirNo = i
    End If
Next i
End Sub