Çözüldü Aktif Hücrelere VBA ile Kenarlık Ekleme

[ridvanucok]

Merhaba,

Sürekli satır sayısı değişen bir raporum mevcut. Bu raporumda A:B, D:E, G:H hücrelerinde işlemler oluyor. Bu sütunlarda dolu olan hücrelere kenarlık eklemek istiyorum. Elimde sadece belirtilen satır kadar kenarlık eklemek için kod var. Kıymetli bilgi ve yardımlarınızı rica ederim.

Dim N As Integer
For N = 1 To 4
[A1:B60].Borders(N).LineStyle = 1
'[A1:B60].Borders(x).Color = RGB(255, 255, 0)'Sarı Renkte olması için aktif edilebilir.
Next N

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodları kullanın.

Sub KenarlıkEkle()
    Dim N As Integer
    Dim SonSatir As Long
    SonSatir = Cells(Rows.Count, "A").End(3).Row
    For N = 1 To 4
        Range("A1:B" & SonSatir).Borders(N).LineStyle = 1
        Range("D1:E" & SonSatir).Borders(N).LineStyle = 1
        Range("G1:H" & SonSatir).Borders(N).LineStyle = 1
    Next N
End Sub

 

[ridvanucok]

Merhaba.

Aşağıdaki kodları kullanın.

Sub KenarlıkEkle()
    Dim N As Integer
    Dim SonSatir As Long
    SonSatir = Cells(Rows.Count, "A").End(3).Row
    For N = 1 To 4
        Range("A1:B" & SonSatir).Borders(N).LineStyle = 1
        Range("D1:E" & SonSatir).Borders(N).LineStyle = 1
        Range("G1:H" & SonSatir).Borders(N).LineStyle = 1
    Next N
End Sub

Üstadım merhaba,

Verdğiniz kodlar Asütunundaki dolu satır kadar tablo yapıyor. Oysaki A1:B, D1:E, G1:H sütunları her biri birbirinden fakrlı tablolar ve satır adeti içerdiğinden her birinin benzersiz olması için uğraşıyorum. Kıymetli yardımlarınızı rica ederim.


Ayrıca her tablo birbirinden farklı olduğundan, çözüm önerisi olarak, verdiğniiz kodları 3'e böldüm. Başarılı sonuç aldım. Tabii daha kısa bir kod ile destekleyebilirseniz bundan sonraki kullanımlarım için daha iyi olur. Teşekkür ederim,

Dim N As Integer
Dim SonSatir As Long
SonSatir = Cells(Rows.Count, "A").End(3).Row
For N = 1 To 4
Range("A1:B" & SonSatir).Borders(N).LineStyle = 1
Next N

Dim Z As Integer
Dim SonSatir1 As Long
SonSatir1 = Cells(Rows.Count, "D").End(3).Row
For Z = 1 To 4
Range("D1:E" & SonSatir1).Borders(Z).LineStyle = 1
Next Z


Dim N1 As Integer
Dim SonSatir2 As Long
SonSatir2 = Cells(Rows.Count, "G").End(3).Row
For N1 = 1 To 4
Range("G1:H" & SonSatir2).Borders(N1).LineStyle = 1
Next N1

 

[Muzaffer Ali]

O zaman aşağıdaki kodları kullanın.

Sub KenarlıkEkle()
    Dim N As Integer
    For N = 1 To 4
        Range("A1:B" & Cells(Rows.Count, "A").End(3).Row).Borders(N).LineStyle = 1
        Range("D1:E" & Cells(Rows.Count, "D").End(3).Row).Borders(N).LineStyle = 1
        Range("G1:H" & Cells(Rows.Count, "G").End(3).Row).Borders(N).LineStyle = 1
    Next N
End Sub

 

[ridvanucok]

O zaman aşağıdaki kodları kullanın.

Sub KenarlıkEkle()
    Dim N As Integer
    For N = 1 To 4
        Range("A1:B" & Cells(Rows.Count, "A").End(3).Row).Borders(N).LineStyle = 1
        Range("D1:E" & Cells(Rows.Count, "D").End(3).Row).Borders(N).LineStyle = 1
        Range("G1:H" & Cells(Rows.Count, "G").End(3).Row).Borders(N).LineStyle = 1
    Next N
End Sub

Üstadım, emeğinize sağlık. Teşekkür ederim.

 

[Ömer BARAN]

Merhaba.

Konu çözülmüş ancak alternatif olsun.

Sayın @dalgalikur 'un verdiği kod, aşağıdaki şekilde düzenlendiğinde de aynı sonuç alınabilir.

Sub KenarlıkRenkEkle()
    For N = 1 To 7 Step 3
        Range(Cells(1, N), Cells(Cells(Rows.Count, N).End(3).Row, N + 1)).Borders.LineStyle = 1
        Range(Cells(1, N), Cells(Cells(Rows.Count, N).End(3).Row, N + 1)).Interior.ColorIndex = 6
    Next N
End Sub

 

[çıtır]

Sayın ridvanucok
Kenarlık ve sarı renk istemişti.
Alternatif olarak kenarlık ve sarı renk

Sub kenarrenk()
Dim alan As Range:Dim s1 As worksheet
Set s1 = Sheets("Sayfa1")
Application.ScreenUpdating = False
For Each alan In Range("A1:H" & s1.UsedRange.Rows.Count)
If alan.Column <> 3 And alan.Column <> 6 And alan <> "" Then
alan.Borders.LineStyle = xlContinuous
alan.Interior.Color = RGB(255, 255, 0)
Else
alan.Borders.LineStyle = xlNone
alan.Interior.Color = xlNone
End If
Next
Application.ScreenUpdating = True
End Sub

 

[Ömer BARAN]

.
Renk ile ilgili bir istek fark edemedim ama, son cevabımdaki kod'u renk için ekleme yaparak güncelledim.
.

 

[ridvanucok]

Üstadlarım, ilginizden dolayı hepinize teşekkür ederim. Tüm verdiğiniz kodlar ile sonuca başarılı bir şekilde ulaştım.

Saygılarımla,

 

[çıtır]

Üstadlarım, ilginizden dolayı hepinize teşekkür ederim. Tüm verdiğiniz kodlar ile sonuca başarılı bir şekilde ulaştım.

Saygılarımla,

Rica ederim.Dönüş yaptığınız için teşekkür ederim.Bilmukabele

 

[comand0]

Üstadım, emeğinize sağlık. Teşekkür ederim.

Hocam kod çalışıyor ama 1. hücreden başlıyor. Ek resimdeki için nasıl bişey yapabiliriz. Sizin kodu denedim sayfa yapısını bozdu