Kalın Çizgi!!

[shenko]

Aşağıdaki makroyu sadece "B5" için değilde B5:B65536 olarak bütün satırlara uygulamasını nasıl isteyebilirim?

Sub seçkalıncizgiyap()
If Range("B5").Font.Name = "Arial Black" Then
Range("A4:G4").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With

Else
Exit Sub
End If
End Sub

 

[mehmett]

Aşağıdaki kodları deneyin.

Sub seçkalıncizgiyap()
son = [b65536].End(3).Row
For x = 5 To son
If Range("B" & x).Font.Name = "Arial Black" Then
Range("A" & x - 1 & ":G" & x - 1).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
Next

 

[shenko]

Değerli üstad memett,

Evet verdiğiniz makro istediğim gibi. Ellerinize sağlık..

Birde makroya eklediklerinizin bir açıklamasını yaparsanız çok memnun olurum.

Saygılar..

 

[mehmett]

Sub seçkalıncizgiyap()
son = [b65536].End(3).Row ' B sütunundaki en son dolu hücrenin satır numarasını bulur.
For x = 5 To son ' x değerini 5'den son'a kadar değiştirir.
If Range("B" & x).Font.Name = "Arial Black" Then ' Bx hücresinin Arial Black olup olmadığına bakar.
Range("A" & x - 1 & ":G" & x - 1).Select 'Eğer Bx hücresi Arial Black ise bir üst satırı seçer
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End If
Next ' x'in değerini 1 arttırır
End Sub

 

[shenko]

Bu aydınlatıcı bilgiler için size çok teşekkürederim...