Kenarlık Ekleme

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,518
Excel Vers. ve Dili
2021 LTSC TR
Altın Üyelik Bitiş Tarihi
18-06-2026
F3:M aralığındaki hücreler formüllü olduğu için aşağıdaki kod dolu görerek tamamına kenarlık ekliyor. Aşağıdaki kodu satırda bulunan hücre SIFIRDAN BÜYÜKSE kenarlık eklemesi için nasıl düzenleyebiliriz?


Kod:
Option Explicit
Sub KENARLIK_EKLE()
    With Sheets("Sayfa1").Columns("f:m")
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
 
    With Sheets("Sayfa1").Range("f2:m" & [Sayfa1!f65536].End(3).Row)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,330
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Option Explicit

Sub Kenarlik_Ekle()
    Dim Son As Long
    
    Sheets("Sayfa1").Range("F2:M" & Rows.Count).Borders.LineStyle = xlNone
    
    Son = Evaluate("LOOKUP(2,1/((F:F<>"""")*(F:F>0)),ROW(F:F))")

    Sheets("Sayfa1").Range("F2:M" & Son).Borders.LineStyle = 1
End Sub
 

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,518
Excel Vers. ve Dili
2021 LTSC TR
Altın Üyelik Bitiş Tarihi
18-06-2026
Eline koluna sağlık Korhan Abi
Teşekkür ederim
 
Üst