Sütundaki son verileri çerçeve içerisine almak.

[barışD34]

Selam arkadaşlar,
E sütununda sürekli alt alta eklenen sayısal veriler mevcut.
Bu verilerin bazı kontrolleri yapılırken son 14 satırdaki kayıtlarda bazı gözlemler yapılıyor.

Dolayısıyla her defa son 14 veriyi saymak kolay ve pratik olmaktan çıkıyor.

Buna bağlı olarak E sütununa sürekli her gün yeni veri eklendiği göz önüne alınırsa , son 14 dikey veriyi , kırmızı bir çerçeve içerisine makro ile nasıl alabiliriz.
Eğer mümkünse çerçeve kalınlığı ayarlanabilir mi?

 

[pitchoute]

Merhaba, deneyip sonucu paylaşabilir misiniz;

Sub SonOnDortVeriCercevele()
    Dim sonSatir As Long
    Dim cerceveBolgesi As Range
    
    sonSatir = Cells(Rows.Count, "E").End(xlUp).Row
    If sonSatir >= 14 Then
        Set cerceveBolgesi = Range("E" & (sonSatir - 13) & ":E" & sonSatir)
    Else
        Set cerceveBolgesi = Range("E1:E" & sonSatir)
    End If
    
    Cells.BorderAround ColorIndex:=0
    With cerceveBolgesi.BorderAround(Weight:=xlMedium)
        .Color = RGB(255, 0, 0) 
        .Weight = xlMedium       ' Kalınlık ayarı (xlThin ince, xlMedium orta, xlThick kalın)
    End With
    
    Application.CutCopyMode = False
End Sub

 

[barışD34]

Merhaba, deneyip sonucu paylaşabilir misiniz;

Sub SonOnDortVeriCercevele()
    Dim sonSatir As Long
    Dim cerceveBolgesi As Range
  
    sonSatir = Cells(Rows.Count, "E").End(xlUp).Row
    If sonSatir >= 14 Then
        Set cerceveBolgesi = Range("E" & (sonSatir - 13) & ":E" & sonSatir)
    Else
        Set cerceveBolgesi = Range("E1:E" & sonSatir)
    End If
  
    Cells.BorderAround ColorIndex:=0
    With cerceveBolgesi.BorderAround(Weight:=xlMedium)
        .Color = RGB(255, 0, 0)
        .Weight = xlMedium       ' Kalınlık ayarı (xlThin ince, xlMedium orta, xlThick kalın)
    End With
  
    Application.CutCopyMode = False
End Sub

Öncelikle yardımız için teşekkür ederim.
Evet seçimi başarılı şekilde yapıyor sadece kod sonunda .Color = RGB(255, 0, 0) satırında hata penceresi çıkıyor.
Kırmızı kod yazılmasına rağmen siyah çerçeve içine alıyor olmasından bir sorun olabilir mi ?

 

[pitchoute]

Şu şekilde dener misiniz hocam hata devam ediyor mu;

Sub SonOnDortVeriCercevele()
    Dim sonSatir As Long
    Dim cerceveBolgesi As Range
 
    sonSatir = Cells(Rows.Count, "E").End(xlUp).Row
    If sonSatir >= 14 Then
        Set cerceveBolgesi = Range("E" & (sonSatir - 13) & ":E" & sonSatir)
    Else
        Set cerceveBolgesi = Range("E1:E" & sonSatir)
    End If
 
    Cells.BorderAround ColorIndex:=0
    
    With cerceveBolgesi.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = RGB(255, 0, 0)
        .Weight = xlMedium
    End With
    With cerceveBolgesi.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = RGB(255, 0, 0)
        .Weight = xlMedium
    End With
    With cerceveBolgesi.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = RGB(255, 0, 0)
        .Weight = xlMedium
    End With
    With cerceveBolgesi.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = RGB(255, 0, 0)
        .Weight = xlMedium
    End With
 
    Application.CutCopyMode = False
End Sub

 

[barışD34]

Şu şekilde dener misiniz hocam hata devam ediyor mu;

Sub SonOnDortVeriCercevele()
    Dim sonSatir As Long
    Dim cerceveBolgesi As Range

    sonSatir = Cells(Rows.Count, "E").End(xlUp).Row
    If sonSatir >= 14 Then
        Set cerceveBolgesi = Range("E" & (sonSatir - 13) & ":E" & sonSatir)
    Else
        Set cerceveBolgesi = Range("E1:E" & sonSatir)
    End If

    Cells.BorderAround ColorIndex:=0
   
    With cerceveBolgesi.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = RGB(255, 0, 0)
        .Weight = xlMedium
    End With
    With cerceveBolgesi.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = RGB(255, 0, 0)
        .Weight = xlMedium
    End With
    With cerceveBolgesi.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = RGB(255, 0, 0)
        .Weight = xlMedium
    End With
    With cerceveBolgesi.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = RGB(255, 0, 0)
        .Weight = xlMedium
    End With

    Application.CutCopyMode = False
End Sub

Şimdi kusursuz çalışıyor.
Emeğinize sağlık çok teşekkür ederim.
Sürekli fare ile seçili hale getirip sayfa altından sayıyı kontrol ediyordum.
İyi çalışmalar dilerim.

 

[pitchoute]

Çalışıyor olmasına sevindim. Rica ederim, iyi çalışmalar hocam.