yatayda birleşik hücrede otomatik satır aralığı

[euphrates55]

örnek içerisinde de açıkladığım gibi yatayda birleşik hücre içindeki yazının otomatik olarak ayarlanması için kod yazılabiliyor mu? ayrıca belli bir aralıktaki hücre boş ise gizlenmesini rica edeceğim. teşekkürler...

 

[euphrates55]

@Korhan Ayhan ın yazmış olduğu bir kod buldum. bunu biraz değiştirme şansımız olursa işimi görecek. öncelikle bunu a14:I23 aralığında yapmalıyım. bu kod tüm satırlar için işlem uyguluyor. konunun olduğu yerde aralık üzerine yazılmış kod çalışmasını da yapmış korhan ayhan ama kod hata veriyor. tekrar gözden geçirilmesi gerekli sanırım.
bir diğer sorun ise 2 satırdan fazla olan cümleler için yazının son satırı bende gözükmüyor. her satır için fazladan bir boş satır varmış gibi olması da fena olmaz aslında.
konunun geçtiği link https://www.excel.web.tr/threads/birlestirilmis-huecrelerde-otomatik-satir-yueksekligi.176267/ burada.

 

[Seyit Tiken]

Örnek kodu kendinize uyarlayınız, Hücre Biçimlendirme'de Metni Kaydır'ınız.

Private Sub Worksheet_Change(ByVal Target As Range)
[a1].RowHeight = Len([a1].Value)
End Sub

 

[Kartal-göz]

Aşağıdaki kodu deneyebilirsiniz.

Sub XDsatIR_YUKSEKLIGI()
Dim XDsut, XDgen, yuk, XDsat
Application.ScreenUpdating = False
Columns(10).Insert
For XDsut = 1 To 9: XDgen = XDgen + Cells(1, XDsut).ColumnWidth: Next
Columns(10).ColumnWidth = XDgen
For XDsat = 14 To 34
    If XDsat = 16 Then XDsat = 17
    If XDsat = 19 Then XDsat = 30
    If XDsat = 32 Then XDsat = 33
    Cells(XDsat, 10) = Cells(XDsat, 1): Rows(XDsat).AutoFit
    yuk = Rows(XDsat).RowHeight: Rows(XDsat).RowHeight = yuk
Next: Columns(10).Delete
Application.ScreenUpdating = True
End Sub

 

[euphrates55]

Çok uzun oldu ama en sağlamı bu şekilde oldu. çok fazla satırım olmadığı için bu şekilde çözdüm. örnek olarak buraya bırakayım. diğer türlü uymayan yerler oluyor. hücre değiştikçe satır aralığının değişmesi için makro çalıştığı için geri alma deaktif olduğundan dolayı en son düğme ile çözmek daha mantıklı geldi. ilgilenen arkadaşlara teşekkürler.

Sub hucreayarla()
Set a = ActiveSheet

If a.[V14] = 0 Then
[B14].RowHeight = 1

ElseIf a.[V14] > 1 And a.[V14] < 70 Then
[B14].RowHeight = 40

ElseIf a.[V14] >= 71 And a.[V14] < 140 Then
[B14].RowHeight = 60

ElseIf a.[V14] >= 141 And a.[V14] < 210 Then
[B14].RowHeight = 80

ElseIf a.[V14] >= 211 And a.[V14] < 280 Then
[B14].RowHeight = 100

ElseIf a.[V14] >= 281 And a.[V14] < 350 Then
[B14].RowHeight = 120

ElseIf a.[V14] >= 351 And a.[V14] < 450 Then
[B14].RowHeight = 160

ElseIf a.[V14] >= 451 Then
[B14].RowHeight = 180

End If

If a.[V15] = 0 Then
[B15].RowHeight = 1

ElseIf a.[V15] > 1 And a.[V15] < 70 Then
[B15].RowHeight = 40

ElseIf a.[V15] >= 71 And a.[V15] < 140 Then
[B15].RowHeight = 60

ElseIf a.[V15] >= 141 And a.[V15] < 210 Then
[B15].RowHeight = 80

ElseIf a.[V15] >= 211 And a.[V15] < 280 Then
[B15].RowHeight = 100

ElseIf a.[V15] >= 281 And a.[V15] < 350 Then
[B15].RowHeight = 120

ElseIf a.[V15] >= 351 And a.[V15] < 450 Then
[B15].RowHeight = 160

ElseIf a.[V15] >= 451 Then
[B15].RowHeight = 180

End If

If a.[V16] = 0 Then
[B16].RowHeight = 0

ElseIf a.[V16] > 1 And a.[V16] < 70 Then
[B16].RowHeight = 40

ElseIf a.[V16] >= 71 And a.[V16] < 140 Then
[B16].RowHeight = 60

ElseIf a.[V16] >= 141 And a.[V16] < 210 Then
[B16].RowHeight = 80

ElseIf a.[V16] >= 211 And a.[V16] < 280 Then
[B16].RowHeight = 100

ElseIf a.[V16] >= 281 And a.[V16] < 350 Then
[B16].RowHeight = 120

ElseIf a.[V16] >= 351 And a.[V16] < 450 Then
[B16].RowHeight = 160

ElseIf a.[V16] >= 451 Then
[B16].RowHeight = 180

End If

If a.[V17] = 0 Then
[B17].RowHeight = 0

ElseIf a.[V17] > 1 And a.[V17] < 70 Then
[B17].RowHeight = 40

ElseIf a.[V17] >= 71 And a.[V17] < 140 Then
[B17].RowHeight = 60

ElseIf a.[V17] >= 141 And a.[V17] < 210 Then
[B17].RowHeight = 80

ElseIf a.[V17] >= 211 And a.[V17] < 280 Then
[B17].RowHeight = 100

ElseIf a.[V17] >= 281 And a.[V17] < 350 Then
[B17].RowHeight = 120

ElseIf a.[V17] >= 351 And a.[V17] < 450 Then
[B17].RowHeight = 160

ElseIf a.[V17] >= 451 Then
[B17].RowHeight = 180

End If

If a.[V18] = 0 Then
[B18].RowHeight = 0

ElseIf a.[V18] > 1 And a.[V18] < 70 Then
[B18].RowHeight = 40

ElseIf a.[V18] >= 71 And a.[V18] < 140 Then
[B18].RowHeight = 60

ElseIf a.[V18] >= 141 And a.[V18] < 210 Then
[B18].RowHeight = 80

ElseIf a.[V18] >= 211 And a.[V18] < 280 Then
[B18].RowHeight = 100

ElseIf a.[V18] >= 281 And a.[V18] < 350 Then
[B18].RowHeight = 120

ElseIf a.[V18] >= 351 And a.[V18] < 450 Then
[B18].RowHeight = 160

ElseIf a.[V18] >= 451 Then
[B18].RowHeight = 180

End If


If a.[V19] = 0 Then
[B19].RowHeight = 1

ElseIf a.[V19] > 1 And a.[V19] < 70 Then
[B19].RowHeight = 40

ElseIf a.[V19] >= 71 And a.[V19] < 140 Then
[B19].RowHeight = 60

ElseIf a.[V19] >= 141 And a.[V19] < 210 Then
[B19].RowHeight = 80

ElseIf a.[V19] >= 211 And a.[V19] < 280 Then
[B19].RowHeight = 100

ElseIf a.[V19] >= 281 And a.[V19] < 350 Then
[B19].RowHeight = 120

ElseIf a.[V19] >= 351 And a.[V19] < 450 Then
[B19].RowHeight = 160

ElseIf a.[V19] >= 451 Then
[B19].RowHeight = 180

End If

If a.[V20] = 0 Then
[B20].RowHeight = 0

ElseIf a.[V20] > 1 And a.[V20] < 70 Then
[B20].RowHeight = 40

ElseIf a.[V20] >= 71 And a.[V20] < 140 Then
[B20].RowHeight = 60

ElseIf a.[V20] >= 141 And a.[V20] < 210 Then
[B20].RowHeight = 80

ElseIf a.[V20] >= 211 And a.[V20] < 280 Then
[B20].RowHeight = 100

ElseIf a.[V20] >= 281 And a.[V20] < 350 Then
[B20].RowHeight = 120

ElseIf a.[V20] >= 351 And a.[V20] < 450 Then
[B20].RowHeight = 160

ElseIf a.[V20] >= 451 Then
[B20].RowHeight = 180

End If

End Sub