dolu hücrelerin etrafına çerçeve

[zulfuernek]

a sütununda hücre dolu ise hücrenin dolu olduğu satır e sütununa kadar dört tarafı çerçeveye almasını istiyorum.

mesela a5 hücresi dolu ise a5:e5 satırının dört tarfınıda çerçeveye almasını istiyorum

 

[Ömer BARAN]

Merhaba.

Örneğin 2'nci satırdan A sütunundaki son dolu satıra kadar aşağıdaki kod istenilen şeyi yapar.
.

[B]Sub CERCEVE()[/B]
For sat = 2 To Cells(Rows.Count, "A").End(3).Row
    If Cells(sat, "A").Value <> "" Then
        Range("A" & sat & ":E" & sat).Borders.LineStyle = xlContinuous
        Range("A" & sat & ":E" & sat).Borders(xlInsideVertical).LineStyle = xlNone
    End If
Next
[B]End Sub[/B]

 

[mydestek]

Merhaba Ömer bey,
Tüm sayfayı tarayıp dolu hücerelerin nasıl kenar çizgisi ekleye bilirim?

 

[AdemCan]

Merhaba, Aktif Sayfadaki dolu hücrelere kenarlık eklemek için kod.
Sayfadaki dolu hücre sayısına göre kodun çalışmasında yavaşlık olabilir.

Sub test()
Application.ScreenUpdating = False
Dim ws As Worksheet, hucre As Range
Set ws = ActiveSheet

With ws
    .Cells.Borders(xlInsideVertical).LineStyle = xlNone
    .Cells.Borders(xlInsideHorizontal).LineStyle = xlNone
        For Each hucre In .UsedRange
            If hucre <> "" Then
                With hucre
                    .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 If
        Next
End With
Application.ScreenUpdating = True
End Sub

 

[mydestek]

Çok sağolun teşekkürler

 

[AdemCan]

Rica ederim.

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Sub Add_Borders()
    With Cells
        .Borders.LineStyle = xlNone
        Union(.SpecialCells(xlCellTypeFormulas, 23), .SpecialCells(xlCellTypeConstants, 23)).Borders.LineStyle = 1
    End With
End Sub