Excel Birleştirilmiş Hücrelerde Satır Yüksekliğini Otomatik Ayarlayan Makro Kodu
Ofislerde veya kurumlarda kullanılan ve Microsoft Office uygulamaları arasında en popüler olan Excel programında satır yüksekliğini ayarlamak çok basit bir işlemdir. Asıl sorun birleştirilmiş hücrelerde satır yüksekliğini otomatik olarak ayarlamaktadır.
Yakın zamanda çalıştığım bir proje ile ilgili excel çalışma sayfasında otomatik satır yüksekliği ayarlamam gerekti. Bunun için makro yapmak çok kolay, ancak verinin bulunduğu hücreler birleştirilmiş hücre olunca otomatik satır yüksekliği ayarlamak gerçekten zor oldu.
Türkçe sitelerde çok fazla arama yaptım ancak sorunu çözecek bir cevap bulamadım. Yabancı sitelerde yaptığım araştırma neticesinde mrexcel.com adlı sitede tam da aradığım cevabı buldum. Mrexcel forumunda Mark858 rumuzlu üyenin verdiği cevap tam olarak şunu yapmakta: Birleştirilmiş hücrelerde satır yüksekliğini otomatik ayarlamak. İlgili mesajda paylaşılan kodu aynen aşağıda paylaştım. Excel çalışma sayfanızı açıp, Alt+11 tuş kombinasyonu ile Vb çalışma sayfasını açıp modül ekleyip, modül içerisine de aşağıdaki kodu yazarak makroyu oluşturabilirsiniz.
Bahse konu kod:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 |
Sub MergedAreaRowAutofit() Dim j As Long Dim n As Long Dim i As Long Dim MW As Double 'merge width Dim RH As Double 'row height Dim MaxRH As Double Dim rngMArea As Range Dim rng As Range Const SpareCol As Long = 26 Set rng = Rows("2:2") With rng For j = 1 To .Rows.Count 'if the row is not hidden If Not .Parent.Rows(.Cells(j, 1).Row) _ .Hidden Then 'if the cells have data If Application.WorksheetFunction _ .CountA(.Rows(j)) Then MaxRH = 0 For n = .Columns.Count To 1 Step -1 If Len(.Cells(j, n).Value) Then 'mergecells If .Cells(j, n).MergeCells Then Set rngMArea = _ .Cells(j, n).MergeArea With rngMArea MW = 0 If .WrapText Then 'get the total width For i = 1 To .Cells.Count MW = MW + _ .Columns(i).ColumnWidth Next MW = MW + .Cells.Count * 0.66 'use the spare column 'and put the value, 'make autofit, 'get the row height With .Parent.Cells(.Row, SpareCol) .Value = rngMArea.Value .ColumnWidth = MW .WrapText = True .EntireRow.AutoFit RH = .RowHeight MaxRH = Application.Max(RH, MaxRH) .Value = vbNullString .WrapText = False .ColumnWidth = 8.43 End With .RowHeight = MaxRH End If End With ElseIf .Cells(j, n).WrapText Then RH = .Cells(j, n).RowHeight .Cells(j, n).EntireRow.AutoFit If .Cells(j, n).RowHeight < RH Then _ .Cells(j, n).RowHeight = RH End If End If Next End If End If Next .Parent.Parent.Worksheets(.Parent.Name).UsedRange End With End Sub |
Kodu modül içerisine yazdıktan ve kaydettikten sonra çalışma sayfanızı makro içeren excel kitabı olarak kaydedip, görünüm menüsünden makro kısmından çalıştırabilirsiniz.
