Excel de yaklaşan tarihi uyarma

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,175
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. captainn, sizin istediğinize göre yani tarihe 10 gün ve daha az kalanlar yeşil veya kırmızı olsun istediğiniz halde neden 2012 tarihli olanlarda kırmızıya dönüyor, burada bir yanlışlık yokmu sizce.
 
Katılım
26 Kasım 2012
Mesajlar
750
Excel Vers. ve Dili
Excel 2007 Türkçe
tahsin bey haklısınız..baya bi hata yapmışız..dosyayı tekrardan düzenledim..4 sütununda koşullu biçimlendirlmesi tekrardan yapıldı..dosya ektedir captainn.
 

Ekli dosyalar

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,175
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Aktarma kodları farklı olarak altarnatif

Sn.apocalyt Koşullu biçimlendirme kodları mükemmel olmuş, bende aktarma kodları farklı olarak uyarlamıştım, Altarnatif olsun.
J1 ve K1 hücrelerindeki tarih aralığını aktaran kodlar
Kod:
Option Explicit
 
Sub İKİ_TARİH_ARASI_SIRALI_LİSTELE()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Satır As Long, Veri As Range
    Set S1 = Sheets("Portföy")
    Set S2 = Sheets("TAKİP")
    S2.Select
    Satır = 2
    Application.ScreenUpdating = False
    S2.[A2:I65000].ClearContents
        For Each Veri In S1.Range("F2:I" & S1.[F65536].End(xlUp).Row)
            If Veri.Value >= S1.[J1] And Veri.Value <= S1.[K1] Then
            S2.Range("A" & Satır & ":I" & Satır).Value = S1.Range("A2" & Veri.Row & ":I" & Veri.Row).Value
            Satır = Satır + 1
            End If
        Next
    Range("A2:I65536").EntireColumn.AutoFit
    Range("A2:I65536").Sort Range("A1")
    Set S1 = Nothing
    Set S2 = Nothing
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

Ekli dosyalar

Katılım
26 Kasım 2012
Mesajlar
750
Excel Vers. ve Dili
Excel 2007 Türkçe
eline sağlık üstad..
 
Üst