Aynı Olan Son Tarihin Altına Kalın Çizgi Çekmek

[1Al2Ver]

Merhaba,

Tabloda, "B" sütununa girilen tarihler aynı olduğunda ;

Aynı olan son tarihin altına, "A:Q" sütunu için kalın çizgi atmak istiyorum,

Teşekkür ederim.

 

[Necdet]

Merhaba,

Sub Cizgi()

    Dim Gun As Integer, _
        i   As Long
    
    Gun = Day(Range("B3"))
    
    For i = 3 To Cells(Rows.Count, "B").End(3).Row
        If Not Gun = Day(Cells(i, "B")) Then
            Gun = Day(Cells(i, "B"))
            With Range("A" & i & ":Q" & i).Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThick
            End With
        End If
    
    Next i
    
End Sub

 

[1Al2Ver]

Sayın Necdet merhaba,

İlginiz ve çözüm için çok teşekkür ederim, sağ olun.

Saygılarımla.

 

[Hacı Bayram ÖZKAN]

Merhaba 2 nolu mesajdaki gibi benim örnek dosyadaki gibi kalın çizilmiş olan çizgileri makro ile ince cizgi yapılabilir mi? Buradaki satırlar her ay değişkenlik gösteriyor. Yani çizilmiş alanlar bulunup ince çizile bilir mi?

 

[hamitcan]

Bu şekilde bir deneyin. Formun sınırlarını AG sütunu olarak kabul ettim.

Sub InceCizgi()
    For Each hcr In [a1:ag38]
        If hcr.Borders.Weight = -4138 Then
            hcr.Borders.Weight = 2
        End If
    Next
End Sub

 

[Hacı Bayram ÖZKAN]

Merhaba Sayın Hamitcan bey; çok güzel olmuş harika abim, ama şunu anlamak istiyorum, buradaki çizgiler hepsi aynı sitil ve özellikte ise ince yapıyor. yani bir kısım yerde çift çizgi varsa o zaman kod çalışmıyor, şu -4138 ne demek oluyor, bunu mu çoğaltmak lazım, "hcr.Borders.Weight = 2" bu kodu ince çizgi mi yapıyor, bunu farklı çizgi sitil ve özellikleri için uyguladım, yapmadı nasıl bir değişiklik yapmam lazım. Teşekkürler.

 

[hamitcan]

Koda eklenti yapılabilir. Öncelikle çift çizginin kalınlığını tespit edin. (Örn: msgbox [a1].Borders.Weight ) Sonra da kodu bu şekilde genişletin.
(If hcr.Borders.Weight = XXX Then)

 

[Hacı Bayram ÖZKAN]

Sayın abim uyguladım oldu teşekkür ederim. Eline sağlık

 

[Hacı Bayram ÖZKAN]

SAYIN hamitcan bey; söylediklerinizi uyguladım, örnek dosyada uyguladım ama bazı yerleri yapmıyor, neden acaba, Birleştirilmiş hücre değil, birleştirdim yine yapmadı, hata nerede. Bakarsan sevinirim.

 

[hamitcan]

Hangi hücrede var çift çizgi ?

 

[Hacı Bayram ÖZKAN]

Hocam bu dosyada çift çizgi yok, ama kodları çalıştırdığımda en son eklediğim dosyada soldan bir kopya aldım, bakın orada bazı hücrelerin çizgilerini ince yapmadı, özellikle J21, P18, P19 D26 F26 J26 P26 U26 gibi hücreleri, P18 de birleştirilmemiş hücreler var acama ondan mı yaptı dedim, ama j21 j26 ve p26 gibi hücreleride yapmıyor.

 

[hamitcan]

Böyle dener misiniz ?

Sub InceCizgi()
 For Each Hücre In [d12:Ak54]
    If Hücre.Borders(xlEdgeBottom).LineStyle <> xlNone Then Hücre.Borders(xlEdgeBottom).Weight = xlThin
    If Hücre.Borders(xlEdgeLeft).LineStyle <> xlNone Then Hücre.Borders(xlEdgeLeft).Weight = xlThin
    If Hücre.Borders(xlEdgeTop).LineStyle <> xlNone Then Hücre.Borders(xlEdgeTop).Weight = xlThin
    If Hücre.Borders(xlEdgeRight).LineStyle <> xlNone Then Hücre.Borders(xlEdgeRight).Weight = xlThin
    If Hücre.Borders(xlInsideVertical).LineStyle <> xlNone Then Hücre.Borders(xlInsideVertical).Weight = xlThin
      
Next
MsgBox "Bitti"
End Sub

 

[Hacı Bayram ÖZKAN]

Evet sayın Hamitcan hocam, bu daha güzel oldu, hem her çizgiyi inçe yapıyor, hemde birleştirilmiş ve çerçeve olanları ince çizgi yapıyor, bu daha düzgün ve hoş oldu eline sağlık zahmet verdim. Eline sağlık teşekkürler. Dua ile kal