sıralan satırlara hücre çerçeveleme

[cebelitarık]

Sayın üstadlarım iliştirdiğim kodla sıralanan satırlardan belirlediğim A1 ile Ax ("x " sonu belli olmayan satır numaras&#305 satırlarında mesela A sütunu ile H sutununda bulunan hücreler çizgi ile çerçevelensin istiyorum. son satırdaki veri silindiğinde son satırdaki çerçevede silinecek. Yani sadece içinde veri bulunan satırdaki hücreler çerçeveli olacak.
yardımlarınız için peşinen teşekkür ederim.

sıralama makrom:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [d:d]) Is Nothing Then Exit Sub
Dim i As Long, sr As Long
[A2:A500].ClearContents
For i = 2 To [D500].End(3).Row
If Not Cells(i, 4) = "" Then
sr = sr + 1
Cells(i, 1) = sr
End If
Next
End Sub

çizgi makrom:

With Range("B1:B" & [B65536].End(3).Row).Borders
.LineStyle = xlContinuous
.ColorIndex = 1
.Weight = xlThin
End With

bu iki makro entegre edilecek

 

[programer]

aşağıdaki kodu kendinize göre uyarlarmısınız

Sub cerceve()
Dim yeni As String
sonsutun = "H"
Range("A1").Select
sayi = WorksheetFunction.CountA(Sheets("geçici").Range("a1:a65000"))
yeni = sonsutun + Trim(Str$(Val(sayi)))
With Sheets("geçici").Range("a1:" & yeni)
    .Borders.LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlHairline
    .Borders(xlEdgeLeft).LineStyle = xlHairline
    .Borders(xlEdgeRight).LineStyle = xlHairline
    .Borders(xlEdgeTop).LineStyle = xlHairline
    .Borders(xlInsideVertical).LineStyle = xlHairline
    .Borders(xlInsideHorizontal).LineStyle = xlHairline
End With
End Sub

 

[cebelitarık]

SAYIN programer
ilgin çok teşekkür ederim.
Verdiğin kodu uygulayamadım. Örnek dosyamı ekte veriyorum. Lütfen yardımcı olursan sevinirim.
Teşekkürler

 

[Mahmut Kök]

Aşağıdaki adreste de sizinkine benzer bir konu var. Faydası olabilir.

http://www.excel.web.tr/showthread.php?t=40658

 

[cebelitarık]

sayın hocalarım
isteğim makronun ilk etabı gerçekleşti
değer girilen hücreler çervelenip sıralanmakta ancak değer silindiğinde sırala yenilenmekte fakat çerveve yeni değerlere göre yani eksilen satırlara göre yeniden silinerek düzenlenmemektedir.
sayfa adı: SAYFA1 dir
acil yardımlarınızı bekliyorum.

'BU MAKROLARDA DEĞER GİRİLEN SATIRLARA SIRA NUMARASI VERİLMEKTEDİR
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [d:d]) Is Nothing Then Exit Sub
Dim i As Long, sr As Long
[A2:A500].ClearContents
For i = 2 To [B500].End(3).Row
If Not Cells(i, 4) = "" Then
sr = sr + 1
Cells(i, 1) = sr
End If
Next
'BU MAKRODA SIRA NUMARASI VERİLMİŞ YERLER ÇERÇEVELENEKTEDİR
Dim yeni As String
sonsutun = "D"
sayi = WorksheetFunction.CountA(Sheets("sayfa1").Range("a1:a65000"))
yeni = sonsutun + Trim(Str$(Val(sayi)))
With Sheets("sayfa1").Range("a1:" & yeni)
.Borders.LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlHairline
.Borders(xlEdgeLeft).LineStyle = xlHairline
.Borders(xlEdgeRight).LineStyle = xlHairline
.Borders(xlEdgeTop).LineStyle = xlHairline
.Borders(xlInsideVertical).LineStyle = xlHairline
.Borders(xlInsideHorizontal).LineStyle = xlHairline
End With
End Sub

 

[cebelitarık]

yeni örnek dosya ektedir

 

[Seyit Tiken]

Makrosuz çözümü sunuyorum. Tabloya veri girildiğinde çerçeve çizer, veri silindiğinde çerçevede silinir.

 

[cebelitarık]

sayın seyit tiken
bu çözümü kendi sayfama nasıl uygulayacağım
gönderdiğiniz sayfada olayı anlayamdım
hücre biçimlendirdenmi yaptınız.

 

[Seyit Tiken]

Hücre Biçimlendirme'den yapılmış. Göndermiş olduğunuz örnek dosyanıza göre yaptım.

 

[cebelitarık]

sayın tiken

hücre biçimlendirin neresinden yaptınız bir türlü bulamadım
2 saattir arıyorum .
başka bir tablo için uygulayacağım bulamadım lütfen yardım
selamlar

 

[Seyit Tiken]

Biçim > Koşullu Biçimlendirme...