Birleştirilmiş 3 adet hücrenin içindeki metine göre autofit değerlerini karşılaştırma

[saorest]

Arkadaşlar aynı satırda 3 adet birleştirilmiş hücrem var
Bu hücrelere metin girişi yapıyorum, bir makro ilgili satırdaki birleştirilmiş hücrelerin içindeki veriye göre autofit değerini hesaplamasını ve hesaplama sonucu çıkan 3 adet autofit değerini karşılaştırıp en büyük değer hangisi ise bunu satır birleştirilmiş hücrelerin satır yüksekliği olarak atasın istiyorum.

Bu herhangi bir buton v.s. le değil birleştirilmiş hücrelere veri girildikçe otomatik olarak çalışmalı ve eğer hücrelerde hiçbir değer olmaz ise satır yüksekliğini 20 olarak ayarlaması gerekiyor. Mümkünmüdür acaba?

 

[Necdet]

Merhaba,

Hücreleri neden birleştiriyorsunuz? Birleştirilmiş hücreler her zaman sorun yaratır.

Sütunun genişliğini ayarlayınız. Metni kaydır ve otomatik satır yüksekliği olarak biçimlendiriniz ve metni yazınız. Excel zaten otomatik olarak sütun yüksekliğini ayarlayacaktır.

 

[saorest]

Necdet Bey teşekkürler, birleştirmiş hücrelerin sorun oluşturduğunu konuyu açmadan önce formda araştırdığımda fark etmiştim, malesef ki kullandığım sayfanın üst ve alt tarafında yer alan bilgilerden dolayı sütun genişlikleri çok dar, arada kalan kısımda ise mecburen birleştirilmiş hücre kullanıyorum.

Başka bir arkadaş formdaki başka bir arkdaş için birleştirilmiş 1 hücreye otomatik olarak autofit olacak şekilde bir kod yazmıştı, onu uyarlamaya çalıştım olmadı. (Dosyayı hazırlayan arkadaşımız ikinci bir sayfa kullanıp burada birleştirilmiş hücreyi normal bir hücre ile ilişkilendirmeli işlemler yapmış işin içinden çıkamadım.)

Benimde aklıma; Eğer mümkünse belirttiğim hücre aralıklarının autofit değerlerini set etmek ve If komutu ile autofit değerlerini kıyaslatma ve en büyük olanı satır yüksekliği olarak atamak geldi, yalnız böyle bir şeyin nasıl yapılacağını bilemediğim için konu açtım.

 

[Korhan Ayhan]

Merhaba,

Sanırım benim verdiğim kodları incelemiştiniz. Aşağıdaki kodu sayfanızın kod bölümüne uygulayın. Daha sonra 5. satırdan itibaren hücrelere uzun veriler girip deneme yapın. Kodları örnek dosyanıza göre derledim. Orjinal dosyanızda farklılık varsa kodları yeniden derlemek gerekebilir.

Kod "B5:M1000" hücre aralığında çalışır.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1 As Worksheet, Genislik As Integer, Yukseklik As Integer
    Dim Alan As Range, Uzunluk As Integer, Adres As Range
    Dim Veri As Variant, Satir As Integer, X As Integer
 
    If Intersect(Target, Range("B5:M1000")) Is Nothing Then Exit Sub
 
    Application.ScreenUpdating = False
    Set Adres = Union(Cells(Target.Row, "B"), Cells(Target.Row, "F"), Cells(Target.Row, "J"))
    
    For Each Alan In Adres
        If Uzunluk < Len(Alan) Then
            Uzunluk = Len(Alan)
            Veri = Alan.Text
            Genislik = Alan.Resize(1, 5).Columns.Width
        End If
    Next
     
    Set S1 = Sheets.Add
    Satir = 2
 
    Application.DisplayAlerts = False
 
    With S1
        .Cells.Delete
        .Cells.Font.Size = Target.Font.Size
        .Range("A1") = Veri
        .Range("A:A").WrapText = True
        .Range("A1").VerticalAlignment = xlJustify
        .Range("A1").ColumnWidth = Genislik / 6.7
        .Range("A1").EntireRow.AutoFit
 
        Veri = Split(.Range("A1"), Chr(10))
 
        For X = 0 To UBound(Veri)
            .Cells(Satir, 1) = Veri(X)
            Yukseklik = Yukseklik + .Cells(Satir, 1).RowHeight
            Satir = Satir + 1
        Next
 
        .Delete
    End With
 
    Target.RowHeight = Yukseklik
    
    Set Adres = Nothing
    Set S1 = Nothing
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[saorest]

Korhan Bey
Evet sizin başka bir arkadaş için hazırladığınız kodları kendi dosyama uyarlamaya çalışmış yapamamıştım, cevap için teşekkür ederim, sizi ikinci kez yorduğumunda farkındayım ama;

Şuan verdiğiniz kodları sayfayama göre düzenledim Target.RowHeight = Yukseklik de hata verdi. Ekteki dosyaya göre düzenlemeniz mümkün mü acaba, birde makro aracılığı ile diğer sayfadan birleştrilmiş olan hücrelereme
s1.cells(15,2)=s2.cells(i,3)
s1.cells(15,7)=s2.cells(i,4)
s1.cells(15,13)=s2.cells(i,5)
.
.
.
diye devam eden kodlar ile veri getiriyorum.
*Diğer taraftaki yazıları makro ile bura aldığımda, birleştirilmiş olan hücreye çift tıklama yapmaz isem autofit olmama gibi bir sıkıntı olur mu?
*Eğer öyle ise bunun basit bir yolu var mı, yoksa range yada select li bir döngüyle çözme mi önerirsiniz?