Son Dolu Satıra Kadar Hücre Yüksekliği

[ahmed_ummu]

Merhaba arkadaşlar.

200 küsür satırlık bir sayfam var. Bazen satır yüksekliğini artırmak bazen de eksiltmek gerekiyor. Aşağıdaki kodu denedim ama satır yüksekliğini artrırırken bir sorun olmuyor fakat eksiltirken hem uzun sürüyor hem de 44 satırdan sonrasını eksiltiyor ve önizleme yapınca 88 sayfa gösteriyor. Normalde 9 sayfa olması gerekiyor. Tabi satır yüksekliğini atırınIca veya eksiltince 1-2 sayfa artıp veya eksilebiliyor. Yardımcı olursanız sevinirim.

SATIR YÜKSEKLİĞİNİ ARTIRIRKEN
Set s1 = Sheets("tablo")
For s = 7 To s1.Cells(Rows.Count, "ar").End(xlUp).Row
On Error Resume Next
s1.Cells(s, "a").EntireRow.RowHeight = s1.Cells(s, "a").EntireRow.RowHeight + 1
Next s


SATIR YÜKSEKLİĞİNİ EKSİLTİRKEN
Set s1 = Sheets("tablo")
For s = 7 To s1.Cells(Rows.Count, "ar").End(xlUp).Row
On Error Resume Next
s1.Cells(s, "a").EntireRow.RowHeight = s1.Cells(s, "a").EntireRow.RowHeight -1
Next s

 

[Muzaffer Ali]

Kodda herhangi bir sorun yok ama her iki kodun da başına Application.ScreenUpdating = False sonuna Application.ScreenUpdating = True satırlarını ekleyin hız artacaktır.

Bir de On Error Resume Next satırlarını silin buna ihtiyaç yok.

 

[ahmed_ummu]

Kodda herhangi bir sorun yok ama her iki kodun da başına Application.ScreenUpdating = False sonuna Application.ScreenUpdating = True satırlarını ekleyin hız artacaktır.

Bir de On Error Resume Next satırlarını silin buna ihtiyaç yok.

Muzaffer Ali Bey çok teşekkürler. Çok hızlandı ama yüksekliği artırırken 50. satırdan sonrasını yükseltmiyor. Eksilme yaparken de 50. satırdan sonrasını eksiltiyor.

Kodlar aynen aşağıda ki gibi

Application.ScreenUpdating = False
Set s1 = Sheets("tablo")
For s = 7 To s1.Cells(Rows.Count, "ar").End(xlUp).Row
On Error Resume Next
s1.Cells(s, "a").EntireRow.RowHeight = s1.Cells(s, "a").EntireRow.RowHeight - 1
Next s
Application.ScreenUpdating = True

 

[dEdE]

Merhaba,
Kodunuzda bir sorun yok gibi görünüyor. Ancak ekli resimde "AR" sütunu görünmüyor.
Kodunuzda yer alan s1.Cells(Rows.Count, "ar").End(xlUp).Row satırı hangi değeri alıyor acaba.
Prosedürün başına MsgBox s1.Cells(Rows.Count, "ar").End(xlUp).Row satırını ekleyerek "AR" sütununun dolu olan son satırını bilmek belki bir fikir verebilir.

 

[ahmed_ummu]

Merhaba,
Kodunuzda bir sorun yok gibi görünüyor. Ancak ekli resimde "AR" sütunu görünmüyor.
Kodunuzda yer alan s1.Cells(Rows.Count, "ar").End(xlUp).Row satırı hangi değeri alıyor acaba.
Prosedürün başına MsgBox s1.Cells(Rows.Count, "ar").End(xlUp).Row satırını ekleyerek "AR" sütununun dolu olan son satırını bilmek belki bir fikir verebilir.

Orada T.C. numaraları olduğu için gizledim. Son satır 225 olacak doğrun yani

 

[ahmed_ummu]

Kusura bakayın arkadaşlar. Şimdi de ön izleme de 99 sayfa gösteriyor.

s1.Cells(s, "ar").EntireRow.RowHeight = s1.Cells(s, "ar").EntireRow.RowHeight - 1

Kırmızı olan ar yapınca satırların hepsine uyguluyor fakat bu kez de ön izleme de 99 sayfa gösteriyor.

 

[dEdE]

Yukarıda belirtiğiniz satırı Rows(s).RowHeight = Rows(s).RowHeight - 1 şeklinde değiştirerek dener misiniz?

 

[ahmed_ummu]

Yukarıda belirtiğiniz satırı Rows(s).RowHeight = Rows(s).RowHeight - 1 şeklinde değiştirerek dener misiniz?

Çok teşekkürler arkadaşlar. Şimdi sorunsuz çalışıyor.