• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Birleştirilmiş Hücre En Uygun Satır

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
B

blackhaawk

Katılım
6 Kasım 2011
Mesajlar
8
Excel Vers. ve Dili
2003-2010 türkçe
Arkadaşlar merhaba,

Benim şöyle bir sorunum var. Ecxel 2003'te bir tablo oluşturdum. Bu tabloda bir makro çalışıyor ve içinde bulunduğu klasördeki diğer excellerden veri alıyor. Bu tabloda I-L sütunundaki ve M-Q sütunundaki hücreler birleştirilmiş hücrelerden oluşuyor.Tabloda veriler alındıktan sonra birleştirilmiş hücrelere gelen metnin uzunluğuna göre otomatik olarak en uygun satır yüksekliği oluşabilmesi için bir makro oluşturulabilirmi ? ( 200 satıra yakın bir alanda bu makronun çalışması gerekebilir )
 
Hoşbulduk Korhan Bey,

verdiğiniz linkte yer alan kodu kendi dosyama uyarlamaya çalıştım aslında ancak aynı sayfada hem I-L sütunları hemde M-Q sütunları birleştirilmiş durumda, o kodu I-L için uyarladım ama M-Q sütunlarını içerek şekilde değiştiremedim. Yardımcı olursanız sevinirim.
 
Merhaba,

Aşağıdaki kod çalışır. Fakat satır yüksekliği fazla olan hücreyi en son işlemeniz gerekiyor.

Kod: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1 As Worksheet, VERİ As Variant, Satır As Integer, X As Integer
    Dim GENİŞLİK_1 As Integer, GENİŞLİK_2 As Integer
    Dim YÜKSEKLİK_1 As Double, YÜKSEKLİK_2 As Double
 
    If Intersect(Target, Range("I:Q")) Is Nothing Then Exit Sub
    
    If Cells(Target.Row, "I").Text = "" And Cells(Target.Row, "M").Text = "" Then
        Target.RowHeight = 12.75
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set S1 = Sheets("Sayfa2")
    Satır = 2
    
    GENİŞLİK_1 = Range("I1:L1").Columns.Width
    GENİŞLİK_2 = Range("M1:Q1").Columns.Width
    
    With S1
        .Cells.Delete
        .Cells.Font.Size = Cells(Target.Row, "I").Font.Size
        .Range("A1") = Cells(Target.Row, "I").Text
        .Range("A:A").WrapText = True
        .Range("A1").VerticalAlignment = xlJustify
        .Range("A1").ColumnWidth = GENİŞLİK_1 / 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_1 = YÜKSEKLİK_1 + .Cells(Satır, 1).RowHeight
            Satır = Satır + 1
        Next
    
        .Cells.Delete
        .Cells.Font.Size = Cells(Target.Row, "M").Font.Size
        .Range("A1") = Cells(Target.Row, "M").Text
        .Range("A:A").WrapText = True
        .Range("A1").VerticalAlignment = xlJustify
        .Range("A1").ColumnWidth = GENİŞLİK_2 / 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_2 = YÜKSEKLİK_2 + .Cells(Satır, 1).RowHeight
            Satır = Satır + 1
        Next
        
        .Cells.Delete
    End With
 
    Target.RowHeight = WorksheetFunction.Max(YÜKSEKLİK_1, YÜKSEKLİK_2)
    
    Set S1 = Nothing
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
 
Ellerinize sağlık. Sadece Satır yüksekliği fazla olan hücreyi en son işlemeniz gerekir derken neyi kastediyorsunuz ? Benim kullandığım tabloda veriler otomatik olarak başka excel sayfalarından tarihe göre çekiliyor. Bu yüzden de tarihi önce olan bi tablodan (mesela ilk günkü tablodan)en fazla satır yüksekliği olan metin gelebiliyor ve bazı günler için ilgili satırlara veri gelmeyebiliyor. Bu durumda kodu değiştirmem gerekir mi? Örnek tablo işyerimde olduğu için ekleyemedim, kusura bakmayın .
 
Merhaba,

Üstteki mesajımdaki kodu yeniden güncelledim. Son halini deneyerek sonucu bildirirmisiniz.

Not: "I-Q" sütun aralığını seçtikten sonra BİÇİM-HÜCRELER-HİZALAMA menüsünü açın ve "METNİ KAYDIR" seçeneğini aktif yapın. Bu şekilde birleşmiş hücrelere sığmayan uzunlukta verileriniz olursa daha düzgün görüntü elde edersiniz.
 
Teşekkür ederim, dediğim gibi tablo işyerimde olduğu için tam olarak deneyemiyorum ama olduğuna inanıyorum :) denedikten sonra tekrar sonucu bildiririm. Sağolun.
 
Korhan Bey tekrar merhaba,

Birleştirilmiş hücrelerde en uygun satır yüksekliği ile ilgili sizin verdiğiniz kodu eklemiş olduğum raporumda denedim. Kod iyi olmuş ama kullandığım tablo için biraz sıkıntılı oldu. Şöyleki ekte gönderdiğim dosyada 3 adet ecxel var. "rapor" isimli excel, aynı klasör içinde olmak kaydıyla ekte gönderdiğim diğer excellerden veri çekiyor. Rapordaki makroyu çalıştırırsanız ne demek istediğim net olarak anlaşılır. Sizin hazırladığınız kodu rapora eklediğimde önce hata verdi. Kodu biraz değiştirdim ama bu seferde rapor isimli excel diğerlerinden veri alırken onları açıp kapattığı için her defasında excel kaydedilsin mi sorusunu sordu. Ben çalışmayı aylık yapacağım için ve bu rapor 60 farklı kişiden geldiği için her defasında kaydet/kaydetme diyemiyorum. Birde yanlış görmediysem sizin hazırladığınız kod verilerin hepsini çekmiyo olabilir.(Birleştirilmiş hücrelerden) . Neyse çok uzun oldu sanırım. Ekteki tablolar ile ilgili yardımlarınızı bekliyorum. Teşekkürler
 

Ekli dosyalar

Merhaba,

Bu durumda size modül kodu yazmak gerekiyor.

Aşağıdaki işlemleri uygulayın.

"Rapor" isimli dosyanızın içindeki hazır olan kodun içindeki aşağıdaki satırın üzerine bir alttaki kırmızı renkli satırı yazın.

Kod: 
Application.ScreenUpdating = True

Kod: 
[COLOR=red]SATIRLARIN_YÜKSEKLİĞİNİ_AYARLA[/COLOR]


Daha sonra aşağıdaki kodu boş bir modül ekleyip içine aktarın.

Kod: 
Option Explicit
 
Sub SATIRLARIN_YÜKSEKLİĞİNİ_AYARLA()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim VERİ As Variant, Satır As Integer
    Dim X As Integer, Y As Integer
    Dim GENİŞLİK_1 As Integer, GENİŞLİK_2 As Integer
    Dim YÜKSEKLİK_1 As Double, YÜKSEKLİK_2 As Double
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets(".").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets.Add(, Sheets(Worksheets.Count))
    S2.Name = "."
    
    For X = 6 To S1.Cells(Rows.Count, 1).End(3).Row
    
        If S1.Cells(X, "N").Text = "" And S1.Cells(X, "R").Text = "" Then
            S1.Cells(X, "N").RowHeight = 12.75
        End If
        
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        
        Satır = 2
        
        GENİŞLİK_1 = Range("N1:Q1").Columns.Width
        GENİŞLİK_2 = Range("R1:V1").Columns.Width
        
        With S2
            .Cells.Delete
            .Cells.Font.Size = S1.Cells(X, "N").Font.Size
            .Range("A1") = S1.Cells(X, "N").Text
            .Range("A:A").WrapText = True
            .Range("A1").VerticalAlignment = xlJustify
            .Range("A1").ColumnWidth = GENİŞLİK_1 / 5.3
            .Range("A1").EntireRow.AutoFit
        
            VERİ = Split(.Range("A1"), Chr(10))
        
            For Y = 0 To UBound(VERİ)
                .Cells(Satır, 1) = VERİ(Y)
                YÜKSEKLİK_1 = YÜKSEKLİK_1 + .Cells(Satır, 1).RowHeight
                Satır = Satır + 1
            Next
        
            .Cells.Delete
            .Cells.Font.Size = S1.Cells(X, "R").Font.Size
            .Range("A1") = S1.Cells(X, "R").Text
            .Range("A:A").WrapText = True
            .Range("A1").VerticalAlignment = xlJustify
            .Range("A1").ColumnWidth = GENİŞLİK_2 / 5.3
            .Range("A1").EntireRow.AutoFit
        
            VERİ = Split(.Range("A1"), Chr(10))
        
            For Y = 0 To UBound(VERİ)
                .Cells(Satır, 1) = VERİ(Y)
                YÜKSEKLİK_2 = YÜKSEKLİK_2 + .Cells(Satır, 1).RowHeight
                Satır = Satır + 1
            Next
            
            .Cells.Delete
        End With
        
        If YÜKSEKLİK_1 > 0 Or YÜKSEKLİK_2 > 0 Then
        S1.Cells(X, 1).RowHeight = WorksheetFunction.Max(YÜKSEKLİK_1, YÜKSEKLİK_2)
        End If
        
        YÜKSEKLİK_1 = 0
        YÜKSEKLİK_2 = 0
    Next
    
    Application.DisplayAlerts = False
    Sheets(".").Delete
    Application.DisplayAlerts = True
    
    Set S1 = Nothing
    Set S2 = Nothing
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Aktarım işlemini yapan kodunuzu çalıştırdığınızda satır yüksekliklerini ayarlayan makroda otomatik çalışmış olacaktır. Dilerseniz ayrı bir butona yeni eklediğiniz modüldeki kodu tanımlayarak ihtiyacınız olduğunda ayrıca çalıştırabilirsiniz.
 
Üstad dediğiniz gibi yaptım modul 2'yi açıp kodu ekledim Alt+F8 çalıştır dedim.( bilgi çek ve "Satır Yüksekliği ayarla" her ikisini de çalıştır dedim) ama olmadı siz denemişsinizdir ben bir yerde hata mı yapıyorum acaba ? Birde hatırlatma yapayım 33.-40. satırlar ile 43.-50. satırlardaki birleştirilmiş hücrelerde veri olabilir ve bu satırlara veriler farklı uzunlukta girilebilir, ihtiyacım olan bu satırlada veri olursa bunların tamamının satır yüksekliğini ayarlayabilmek. Umarım çok olmuyorumdur. :)
 
Merhaba,

Birleştirilmiş sütunlarınızı seçip "METNİ KAYDIR" özelliğini uygulayın. Ve üstteki mesajımdaki yazdıklarımı iyi okuyun ve uygulayın.
 
Üstad dediğiniz gib yapmama rağmen olmadı, raporun sizin kodunuzun eklenmiş halini ekledim. zipli dosyada rapor isimli çalışma sizin kodunuzu çalıştırarak oluşturduğum tablodur. rapor 2 de ise raporda benim satır genişliklerini elle ayarladığım tablo yer alıyor. Sizin kodunuzla birlikte raporun bu şekilde çalışması gerekmiyor mu? eğer öyleyse ben nerde hata yapıyorum.
 

Ekli dosyalar

Merhaba,

Kodu ilk önce tek sütun için denemiştim. Olumlu sonuç alınca kod içinde sütun sayısını arttırmıştım. Derlerken hata yapmışım. Üstteki mesajımdaki kodu ve açıklamamı güncelledim. Denedim ve olumlu sonuç aldım. Sizde denermisiniz.

Not : Makronun adınıda düzelttim.
 
Korhan Bey çok güzel olmuş, sayenizde bir günlük işim 1 saate indi, çok teşekkür ederim.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst