Tabloya Tarihe Bağımlı Kenarlık Hk.

[eglacier61]

Merhaba Arkadaşlar, kamyon fişi girdiğim sürekli bi tablom var, buna ayırt edici olması için tarih değiştiğinde araya kalın kenarlık atacak bi biçim özelliği gibi bişey ekleyebilir miyiz ? teşekkürler şimdiden.

 

[Necdet]

Merhaba,

İsteğiniz Koşullu Biçimlendirme ile olabilir ama onda da Kalın Çizgi Yok, ancak Renkli Çizgi olabilir.

Makro ile olsun isterseniz, aşağıdaki kodları ilgili sayfanın kod bölümüne kopyalayıp deneyiniz.
A sütununda değişiklik olduğunda bir önceki A sütunundaki değeri karşılaştırarak A-E sütununda satıra kalın çizgi çizer.
kodu kendinize göre uyarlayınız.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Value <> Target.Offset(-1, 9) Then _
    Range(Cells(Target.Row - 1, "A"), Cells(Target.Row - 1, "E")).Borders(xlEdgeBottom).Weight = 3
End Sub

 

[eglacier61]

kod için önce teşekkür ederim, tarih D sütununda, çizmesini istediğim aralık A ile I sütunları, bu şekilde nasıl uyarlayabilirim, pek bilgim yok malesef makro kısmında

 

[Necdet]

kod için önce teşekkür ederim, tarih D sütununda, çizmesini istediğim aralık A ile I sütunları, bu şekilde nasıl uyarlayabilirim, pek bilgim yok malesef makro kısmında

Tekrar merhaba,
Soru sorarken yukarıdaki açıklamayı peşin peşin yapsaydınız, gereksiz yazışmalar yapmazdık.

If Intersect(Target, [D:D]) Is Nothing Or Target.Row < 2 Then Exit Sub

If Target.Value <> Target.Offset(-1, 0) Then
    With Range("A" & Target.Row & ":I" & Target.Row).Borders(xlEdgeTop)
        .ColorIndex = 3
        .Weight = 4
    End With
End If

End Sub

 

[eglacier61]

merhaba, niyetim koşullu biçimlendirme ile çözebilmekti ama orda da söylediğiniz gibi kalın çizgi yok. Bende belki farklı bi yöntemi vardır bilmediğim için sormak istedim, siz ise makro kısmına yönlendirdiniz. Rahatsız ettiğim için kusura bakmayın Necdet bey.

 

[Necdet]

Rahatsızlık değil,
Net açıklama olmayınca -ki formu incelerseniz gereksiz yazışmalar yapılıyor. oysa sorunuz koşullu biçimlendirme ile çözülse bile yine sütun bilgisi gerekir. Çünkü karşılaştırma gerekiyor.

İyi bayramlar.

 

[eglacier61]

bir dahaki sefere dikkat ederim, teşekkür ederim tekrar, size de iyi bayramlar.

 

[eglacier61]

Hocam denedim ama çalıştıramadım hatamı yaptım bilemiyorum aşağıdaki uyarı ile karşılaşıyorum ;
Run-time '424':
Object required
şeklinde. debug 'a basıncada kodun ;
If Intersect(Target, [D]) Is Nothing Or Target.Row < 2 Then kısmını sarıya boyuyor.

 

[Necdet]

dosyanızı görmek gerek, kodları nereye yazdınız.

 

[eglacier61]

dosya bu şekilde, makroyu kod görüntüle kısmından yazdım

 

[eglacier61]

Hocam openai ile denedim bide şansımı ekteki kod ile çözdüm işimi. zahmetleriniz için çok teşekkür ederim.

Sub KalinCizgiEkle()
    Dim lastRow As Long
    Dim currentRow As Long
    
    lastRow = Cells(Rows.Count, "D").End(xlUp).Row
    
    For currentRow = 2 To lastRow
        If Cells(currentRow, "D").Value <> Cells(currentRow - 1, "D").Value Then
            Range("A" & currentRow & ":I" & currentRow).Borders(xlEdgeTop).LineStyle = xlContinuous
            Range("A" & currentRow & ":I" & currentRow).Borders(xlEdgeTop).Weight = xlThick
        End If
    Next currentRow
End Sub

 

[Necdet]

Merhaba,
Kodu gönderirken (2. kod)
Private Sub Worksheet_Change(ByVal Target As Range)

kodun başlığını göndermeyi unutmuşum, o yüzden başarılı olamamışsınız. Kod şöyle olmalıydı :

Private Sub Worksheet_Change(ByVal Target As Range)

If Intersect(Target, [D:D]) Is Nothing Or Target.Row < 2 Then Exit Sub

If Target.Value <> Target.Offset(-1, 0) Then
    With Range("A" & Target.Row & ":I" & Target.Row).Borders(xlEdgeTop)
        .ColorIndex = 3
        .Weight = 4
    End With
End If

End Sub

Sizin çevirdiğiniz kodlar da daha önce girilen veriler için uygun kod.