hücre birleştir ve ortala

[Hacı Bayram ÖZKAN]

Merhaba arkadaşlar ekli dosyamda tablo oluşturulduktan sonra tablonun tablonun bir satır altına tablonun kaç kişiden oluştuğu aşağıdaki makro ile yazıyor, benim isteğim oluşturma işlemi bittikten sonra bu hücreleri A ile E sütunu arasında bişleştirerek ortalasın, örnek dosya ekliyorum. (Metin makrosunda yapılacak)
Sub Metin()

Dim son As Long, sira As Long

Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).ClearContents

son = Cells(Rows.Count, "C").End(xlUp).Row
sira = Range("A" & son)

Range("A" & son + 2) = "//////////////////////////////// İş bu listenin " & sira _
& "(" & YAZ(sira) & ") kişiden ibaret olduğu tasdik olunur. ////////////////////////////////"""

' Yazıyı oluşturan yerde yani bittiği yerde; A Sütundan E sütuna kadar hücreleri birleştir ve ortala nasıl yazılır.

Range("E" & son + 5) = "ONAY"
Range("E" & son + 6) = Range("E7")
Range("E" & son + 7) = "İlçe Emniyet Müdürü"
Range("E" & son + 8) = "3. Sınıf Emniyet Müdürü"

Range("E" & son + 7).HorizontalAlignment = xlCenter
Range("E" & son + 8).HorizontalAlignment = xlCenter

 

[Hacı Bayram ÖZKAN]

arkadaşlar böyle bir imkan yokmu acaba?

 

[Mahir64]

Merhaba,

Bu işlemi makro kaydet yöntemi ile de yapabilirsiniz.

 

[Hacı Bayram ÖZKAN]

Mahir bey burada A43 E43 dersek her zaman burayı bişleştirmez mi? yani diyelim ki listeye 2 satır daha yazdım, bu sefer ne olacak A45 E45 bunun için birleştirme işlemi listenin son satırının bir sonrası için olacak

 

[Husgvarna]

Merhaba.
Kodlarınızı aşağıdakiyle değiştirip deneyin.

Sub Metin()
    Dim son As Long, sira As Long
[COLOR="Red"]    b = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & b & ":e" & b).HorizontalAlignment = xlGeneral
Range("A" & b & ":e" & b).MergeCells = False[/COLOR]
    Range("A" & Cells(Rows.Count, "A").End(xlUp).Row) = Empty
    son = Cells(Rows.Count, "C").End(xlUp).Row
    sira = Range("A" & son)
 [COLOR="#ff0000"]   Range("A" & son + 1 & ":e" & son + 500) = ""[/COLOR]
    Range("A" & son + 2) = "//////////////////////////////// İş bu listenin " & sira _
                        & "(" & YAZ(sira) & ") kişiden ibaret olduğu tasdik olunur. ////////////////////////////////"
    Range("E" & son + 5) = "ONAY"
    Range("E" & son + 6) = Range("E7")
    Range("E" & son + 7) = "İlçe Emniyet Müdürü"
    Range("E" & son + 8) = "3. Sınıf Emniyet Müdürü"
        
Range("A" & son + 2 & ":e" & son + 2).HorizontalAlignment = xlCenter
Range("A" & son + 2 & ":e" & son + 2).MergeCells = True
Range("E" & son + 7).HorizontalAlignment = xlCenter
Range("E" & son + 8).HorizontalAlignment = xlCenter
End Sub

 

[Hacı Bayram ÖZKAN]

Üstadım oldu ancak diğer bir satır girince (yani listenin altına) önceki birleştirilen satır normal hale gelmesi için nasıl bir kod uygulanır. Kısacası bir kişi ekleyeceğim zaman hücre birleştirilmiş olduğu için yazamıyorum. Teşekkürler.

 

[Hacı Bayram ÖZKAN]

Üstadım oldu ancak diğer bir satır girince (yani listenin altına) önceki birleştirilen satır normal hale gelmesi için nasıl bir kod uygulanır. Kısacası bir kişi ekleyeceğim zaman hücre birleştirilmiş olduğu için yazamıyorum. Teşekkürler.

Dim son As Long, sira As Long
Bu satırdan sonra aşağıdaki kodu girince oldu.
Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).UnMerge
Range("A" & Cells(Rows.Count, "A").End(xlDown).Row).UnMerge
hepinize teşekkürler.

 

[Husgvarna]

Üstadım oldu ancak diğer bir satır girince (yani listenin altına) önceki birleştirilen satır normal hale gelmesi için nasıl bir kod uygulanır. Kısacası bir kişi ekleyeceğim zaman hücre birleştirilmiş olduğu için yazamıyorum. Teşekkürler.

Yukarıdaki değişen kodları kullanın.

Dim son As Long, sira As Long
Bu satırdan sonra aşağıdaki kodu girince oldu.
Range("A" & Cells(Rows.Count, "A").End(xlUp).Row).UnMerge
Range("A" & Cells(Rows.Count, "A").End(xlDown).Row).UnMerge
hepinize teşekkürler.

O şekilde En son dolu hücrenin altında birleştirilmiş hücreler varsa kalacaktır.
Aşağıdaki gibide olabilir.

 Sub Metin()
    Dim son As Long, sira As Long
 
 [COLOR="Red"]   Range("A1:e5000").HorizontalAlignment = xlGeneral
Range("A1:e5000").MergeCells = False[/COLOR]
    Range("A" & Cells(Rows.Count, "A").End(xlUp).Row) = Empty
    son = Cells(Rows.Count, "C").End(xlUp).Row
    sira = Range("A" & son)
    Range("A" & son + 1 & ":e" & son + 500) = ""
    Range("A" & son + 2) = "//////////////////////////////// İş bu listenin " & sira _
                        & "(" & YAZ(sira) & ") kişiden ibaret olduğu tasdik olunur. ////////////////////////////////"
    Range("E" & son + 5) = "ONAY"
    Range("E" & son + 6) = Range("E7")
    Range("E" & son + 7) = "İlçe Emniyet Müdürü"
    Range("E" & son + 8) = "3. Sınıf Emniyet Müdürü"
        
Range("A" & son + 2 & ":e" & son + 2).HorizontalAlignment = xlCenter
Range("A" & son + 2 & ":e" & son + 2).MergeCells = True
Range("E" & son + 7).HorizontalAlignment = xlCenter
Range("E" & son + 8).HorizontalAlignment = xlCenter
End Sub

 

[Hacı Bayram ÖZKAN]

Sayın Husgvarna, eline sağlık teşekkürler hoşçakal.