Birleştirilmiş Hücrede En Uygun Satır Yüksekliği Ayarlama

[baydeniro]

Merhaba akradaşlar. Makro kodu ile "Birleştirilmiş Hücrede En Uygun Satır Yüksekliği Ayarlama" sını gerçekleştiremedim. Bu konuda yardımcı olabilir misiniz !!

 

[baydeniro]

Merhaba akradaşlar. Makro kodu ile "Birleştirilmiş Hücrede En Uygun Satır Yüksekliği Ayarlama" sını gerçekleştiremedim. Bu konuda yardımcı olabilir misiniz !!

 

[omeryılmaz]

Birleştirilmiş Hücrede Satır yüksekliği

Sheets("sayfa1").[A15].RowHeight = 17.51 'Satır Yüksekliği
Veya


Sheets("sayfa1").[A15].RowHeight = TextBox1.Text


veya

Private Sub Worksheet_Change(ByVal Target As Range)
If Len([A15] = 1) Then
[A15].EntireRow.AutoFit
[A15].Rows.AutoFit
Cells.EntireRow.AutoFit
End If
End Sub


veya
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Len(Range("A15"))

Case 0 To 100: Rows("15:15").RowHeight = 24
Case 100 To 200: Rows("15:15").RowHeight = 48
Case 201 To 300: Rows("15:15").RowHeight = 72
Case 301 To 400: Rows("15:15").RowHeight = 96
Case 401 To 500: Rows("15:15").RowHeight = 120
Case 501 To 600: Rows("15:15").RowHeight = 144
End Select
End Sub

 

[baydeniro]

Sayın omeryılmaz ilginize teşekkür ederim. Ancak birleştirilmiş hücrede metni kaydır özelliği yanısıra en Uygun yüksekliği ayarla gerçekleşmedi.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki linkleri inceleyiniz.

girilen metne göre hücrenin açılması ve daralması
Metne göre satır yüksekliği

 

[baydeniro]

Sayın Korhan Ayhan ilginize çok teşekkür ederim. Bu çözümler iyi. Ancak sadece 1 satır için mi çalışır ? belli bir aralığı tanımlamak mümküm olabilir mi ?

 

[Korhan Ayhan]

Merhaba,

Excelde birleştirilmiş hücreler üzerinde işlem yapmak zahmetlidir. Genelde önerilen çözümler örnek dosya odaklıdır. Örnek dosya ekleyerek yardım talebinde bulunursanız size görede çözüm üretebiliriz.

 

[baydeniro]

Sayın Korhan Ayhan ilginize tekrar teşekkür ederim. Örnek dosya ekte. C sütununa başlayıp H sütununda biten "birleştirilmiş hücrelerin" olduğu satırlarda gerektiği kadar yüksekliği kendi ayarlamasına gereksinmem var.

 

[Korhan Ayhan]

Merhaba,

Çalışmanızda "Sayfa1" ve "Sayfa2" olmak şartıyla aşağıdaki kodu "Sayfa1" isimli sayfanızın kod bölümüne uygulayınız.

Daha sonra "C:H" sütunları arasına değer girerek sonucu gözlemleyin.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1 As Worksheet, GENİŞLİK As Integer, YÜKSEKLİK As Integer
    Dim VERİ As Variant, Satır As Integer, X As Integer
 
    If Intersect(Target, Range("C:H")) Is Nothing Then Exit Sub
 
    Application.ScreenUpdating = False
    GENİŞLİK = Range("C1:H1").Columns.Width
 
    Set S1 = Sheets("Sayfa2")
    Satır = 2
 
    Application.DisplayAlerts = False
 
    With S1
        .Cells.Delete
        .Cells.Font.Size = Target.Font.Size
        .Range("A1") = Target.Text
        .Range("A:A").WrapText = True
        .Range("A1").VerticalAlignment = xlJustify
        .Range("A1").ColumnWidth = GENİŞLİK / 5.3
        .Range("A1").EntireRow.AutoFit
 
        VERİ = Split(.Range("A1"), Chr(10))
 
        For X = 0 To UBound(VERİ)
            .Cells(Satır, 1) = VERİ(X)
            YÜKSEKLİK = YÜKSEKLİK + .Cells(Satır, 1).RowHeight
            Satır = Satır + 1
        Next
 
        .Cells.Delete
    End With
 
    Target.RowHeight = YÜKSEKLİK
    Set S1 = Nothing
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[baydeniro]

Süpersiniz sayın Korhan Ayhan, sağlıcakla kalın.