makro için "AN"sütununda hücre yüksekliği

[idealimsin]

makro için "AN"sütununda herhangi satır hücresinde metin yok ise sadece o satırı 25 hücre yüksekliğine ayarlayabilirmiyiz

 

[Muzaffer Ali]

Merhaba.
Sayfanın kod kısmına aşağıdaki kodları kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("AN:AN")) Is Nothing Then
        If Target = "" Then
            Rows(Target.Row).RowHeight = 25
        End If
    End If
End Sub

AN sütununda bir değişiklik olduğunda kodlar çalışacak ve istediğinizi yapacaktır.

 

[idealimsin]

Merhaba.
Sayfanın kod kısmına aşağıdaki kodları kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("AN:AN")) Is Nothing Then
        If Target = "" Then
            Rows(Target.Row).RowHeight = 25
        End If
    End If
End Sub

AN sütununda bir değişiklik olduğunda kodlar çalışacak ve istediğinizi yapacaktır.

cevabınız için çok teşekkür ederim.kodu ekledim.nasıl çalışıyor .bir hareket olmadı onun için

sayfayı hazırladıktan sonra makroyu çalıştırsam daha iyi olur.

 

[Muzaffer Ali]

Yukarıdaki kod "AN" sütununda herhangi bir hücrede değişiklik yaptığınızda sadece değişiklik yapılan hücre için çalışır.

Aşağıdaki kodu normal çalıştırdığınızda "AN" sütunundaki tüm hücreleri kontrol ederek çalışır.

Sub Test()
    Dim Bak As Range
    For Each Bak In Range("AN:AN")
        If Bak = "" Then
            Rows(Bak.Row).RowHeight = 25
        End If
    Next
End Sub

Hangisi işinizi görüyorsa onu kullanırsınız.

 

[idealimsin]

Yukarıdaki kod "AN" sütununda herhangi bir hücrede değişiklik yaptığınızda sadece değişiklik yapılan hücre için çalışır.

Aşağıdaki kodu normal çalıştırdığınızda "AN" sütunundaki tüm hücreleri kontrol ederek çalışır.

Sub Test()
    Dim Bak As Range
    For Each Bak In Range("AN:AN")
        If Bak = "" Then
            Rows(Bak.Row).RowHeight = 25
        End If
    Next
End Sub

Hangisi işinizi görüyorsa onu kullanırsınız.

bu kod tercihimdir.ancak 20 dk bekledim hala işlemdeydi. kapattım. dosyamında 30 mb büyüklüğünde .o yüzdenmi bilemedim.belki sayfanın bütün satırlarınamı bakıyor?. 500 satıra kadar verilerim. işin içinden çıkamadım

 

[Muzaffer Ali]

O zaman şu kodu kullanın.

Sub Test()
    Dim Bak As Range
    Dim SonSatir As Long
    SonSatir = Cells(Rows.Count, "AN").End(xlUp).Row
    For Each Bak In Range("AN1:AN" & SonSatir)
        If Bak = "" Then
            Rows(Bak.Row).RowHeight = 25
        End If
    Next
End Sub

 

[Korhan Ayhan]

"metin yoksa" ifadenizden ne anlamalıyız. Hücre boşsa mı demek istiyorsunuz?

 

[idealimsin]

O zaman şu kodu kullanın.

Sub Test()
    Dim Bak As Range
    Dim SonSatir As Long
    SonSatir = Cells(Rows.Count, "AN").End(xlUp).Row
    For Each Bak In Range("AN1:AN" & SonSatir)
        If Bak = "" Then
            Rows(Bak.Row).RowHeight = 25
        End If
    Next
End Sub

evet bu gayet hızlı saniyesinde işlem yaptı çok teşekkür ederim ellerinize sağlık

 

[idealimsin]

"metin yoksa" ifadenizden ne anlamalıyız. Hücre boşsa mı demek istiyorsunuz?

evet metin yoksa boş.dalgalıkur un verdiği kod çok iyi iş gördü.teşkkür ederim

 

[Korhan Ayhan]

Alternatif;

Hız olarak biraz daha avantaj sağlayacaktır.

Option Explicit

Sub Satir_Yuksekligi_Ayarla()
    Dim Son_Satir As Range, Veri As Range, X As Long, Alan As Range, Zaman As Double
   
    Zaman = Timer
   
    Set Son_Satir = Cells.Find("*", , , , xlByRows, xlPrevious)

    For Each Veri In Range("AN1:AN" & Son_Satir.Row)
        If Veri.Value = "" Then
            If Alan Is Nothing Then
                Set Alan = Veri
            Else
                Set Alan = Union(Alan, Veri)
            End If
        End If
    Next
   
    If Not Alan Is Nothing Then Alan.RowHeight = 25
   
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Eğer AN sütununda hücreler gerçekten boş ise yani (formül girişi sonucu boş olanlar hariç) aşağıdaki kod ile de sonuca gidebilirsiniz.

Option Explicit

Sub Satir_Yuksekligi_Ayarla()
    Dim Son_Satir As Range, Zaman As Double
    
    Zaman = Timer
    
    Set Son_Satir = Cells.Find("*", , , , xlByRows, xlPrevious)

    Range("AN1:AN" & Son_Satir.Row).SpecialCells(xlCellTypeBlanks).RowHeight = 25
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[idealimsin]

Alternatif;

Hız olarak biraz daha avantaj sağlayacaktır.

Option Explicit

Sub Satir_Yuksekligi_Ayarla()
    Dim Son_Satir As Range, Veri As Range, X As Long, Alan As Range, Zaman As Double
  
    Zaman = Timer
  
    Set Son_Satir = Cells.Find("*", , , , xlByRows, xlPrevious)

    For Each Veri In Range("AN1:AN" & Son_Satir.Row)
        If Veri.Value = "" Then
            If Alan Is Nothing Then
                Set Alan = Veri
            Else
                Set Alan = Union(Alan, Veri)
            End If
        End If
    Next
  
    If Not Alan Is Nothing Then Alan.RowHeight = 25
  
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Eğer AN sütununda hücreler gerçekten boş ise yani (formül girişi sonucu boş olanlar hariç) aşağıdaki kod ile de sonuca gidebilirsiniz.

Option Explicit

Sub Satir_Yuksekligi_Ayarla()
    Dim Son_Satir As Range, Zaman As Double
   
    Zaman = Timer
   
    Set Son_Satir = Cells.Find("*", , , , xlByRows, xlPrevious)

    Range("AN1:AN" & Son_Satir.Row).SpecialCells(xlCellTypeBlanks).RowHeight = 25
   
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

ellerinize sağlık ......