Kenarlık oluşturma

[muratkul]

Merhaba
Ekteki tabloda temsil.ıd yazan yere her temsil ıd değiştiğinde aynı temsil ıd olanları dört tarafının kenarlık çizgilerini kalın yapmak istiyorum.Kolay yoldan nasıl keanrlık oluştururum.

 

[muratkul]

Merhaba,
Arkadaşlar nasıl yapacağım konusunda hiç kimsenin bir fikri yokmu acaba.
Her numara dedğiştiğinde o numaraya ait bilgilerin hepsine dıştan dışa kenarlık yapmak istiyorum.

 

[Ömer BARAN]

Merhaba, bildiğim kadarıyla koşullu biçimlendirme ile kalın kenarlık çizilemiyor ama
en basitiyle aşağıdaki gibi bir makro kod ile olabilir.

-- Sayfaya bir metin kutusu/şekil ekleyin,
-- Alt tarafta sayfanın adına fareyle sağ tıklayın ve KOD GÖRÜNTÜLEyi seçin,
-- Açılan ekranın sağ tarafındaki boş alana aşağıdaki kod blokunu yapıştırın,
-- Sayfaya eklediğiniz metin kutusuna/şekle fareyle sağ tıklayın ve MAKRO ATAyı seçin,
-- Açılan küçük ekranda ÇERÇEVE_KENARLIK_BRN adını seçin ve işlemi onaylayın,
-- Sayfaya eklediğiniz metin kutusuna/şekle fareyle tıklayın.
.

[COLOR="blue"][B]Sub ÇERÇEVE_KENARLIK_BRN()[/B][/COLOR]
Columns("A:E").Borders.LineStyle = xlNone: son = [A65536].End(3).Row
With Range("A1:E" & son).Borders: .LineStyle = xlContinuous: .ColorIndex = 16: .Weight = xlThin: End With
For brn = 2 To [A65536].End(3).Row
ilk = WorksheetFunction.Match(Cells(brn, 1), Range("A1:A" & [A65536].End(3).Row), 0)
son = ilk + WorksheetFunction.CountIf(Range("A1:A" & [A65536].End(3).Row), Cells(brn, 1)) - 1
alan = "A" & ilk & ":E" & son: Range(alan).Select
With Selection.Borders(xlEdgeLeft): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeTop): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeBottom): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeRight): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
brn = son: Next: Cells(1, 1).Activate: MsgBox "KENARLIKLAR TAMAM"
[B][COLOR="Blue"]End Sub[/COLOR][/B]

 

[muratkul]

çok teşekkür ederim Ömer bey,
Daha basit bir yöntem yok galiba. istediğim işlemi yapıyor. sağolun

 

[Ömer BARAN]

........... istediğim işlemi yapıyor......

İyi günler dilerim.

 

[muratkul]

Ömer Bey,
Yalnız filtre yaptığım zaman kenarlıklar kayboluyor. Mesla tarihe göre filtre yaptığım zaman örnekteki tablodaki temsil ıd. her değişmesinde ilgili alanın dört tarafını kenarlık yapmasını istiyorum.
Tekrar yardımcı olabilir misiniz.

 

[muratkul]

Merhaba Ömer Baran Bey,
İlgili Kodu A sütunu için değilde C SUTUNU İÇİN TEKRAR düzenleyip göndermenizi rica edebilirmiyim.

 

[muratkul]

Ömer bey ilgili kodu A sutunu değilde C9 SUTUNUNA GÖRE DÜZENLEYİP GÖNDEREBİLİRMİSİNİZ.

Sub ÇERÇEVE_KENARLIK_BRN()
Columns("A:E").Borders.LineStyle = xlNone: son = [A65536].End(3).Row
With Range("A1:E" & son).Borders: .LineStyle = xlContinuous: .ColorIndex = 16: .Weight = xlThin: End With
For brn = 2 To [A65536].End(3).Row
ilk = WorksheetFunction.Match(Cells(brn, 1), Range("A1:A" & [A65536].End(3).Row), 0)
son = ilk + WorksheetFunction.CountIf(Range("A1:A" & [A65536].End(3).Row), Cells(brn, 1)) - 1
alan = "A" & ilk & ":E" & son: Range(alan).Select
With Selection.Borders(xlEdgeLeft): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeTop): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeBottom): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
With Selection.Borders(xlEdgeRight): .LineStyle = xlContinuous: .ColorIndex = 0: .Weight = xlMedium: End With
brn = son: Next: Cells(1, 1).Activate: MsgBox "KENARLIKLAR TAMAM"
End Sub