tarihe göre renk

[polis-53]

Merhaba arkadaşlar ekte göndermiş olduğum dosyada c ve f hücrelerine tarih yazdığım zaman satırı renklendiriyor ama ufak tefek hatalar var galiba f hücresine tarih yazdığımda renkleniyor sildiğimde renk silinmiyor birde tarihi kopyaladığım zaman renklenmiyor bir bakarsanız çok sevinirim.

 

[polis-53]

yazılan tarihe göre renk

Merhaba arkadaşlar ekte göndermiş olduğum dosyada c ve f hücrelerine tarih yazdığım zaman satırı renklendiriyor ama ufak tefek hatalar var galiba f hücresine tarih yazdığımda renkleniyor sildiğimde renk silinmiyor ve c ve f sutunundaki tarihlerin tümünü seçip sildiğimde de hata veriyor birde tarihi kopyaladığım zaman renklenmiyor bir bakarsanız çok sevinirim.

 

[polis-53]

arkadaşlar cevap veren yokmu

 

[polis-53]

Arkadaşlar yanlış birşeymi sordum da cevap alamadım tüm herkesin kandilini kutlarım.

 

[Ömer]

Merhaba,

Sizinde kandiliniz kutlu olsun.

Eski kodları silip, aşağıdakileri sayfanın kod bölümüne kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim aralık As Range, i As Integer, Renk As Integer, tarih As Date
 
If Intersect(Target, [C:C,F:F]) Is Nothing Then Exit Sub
 
On Error GoTo sil
Set aralık = Range(Cells(Target.Row, Target.Column), _
    Cells(Target.Row, Target.Column - 2))
 
Renk = 3
For i = 1 To 365
    Renk = Renk + 1
    If Renk > 56 Then Renk = 4
    tarih = CDate("31.12.2010") + i
    If Target = tarih Then
        aralık.Interior.ColorIndex = Renk
        Exit For
    End If
Next i
sil:
Range(Selection, Selection.Offset(0, -2)).Interior.ColorIndex = 0
 
End Sub

 

[polis-53]

Ömer bey cevap verdiğiniz için çok teşekkür ederim ama çalışmıyor tarih yazdığımda hücreler reklenmiyor.

 

[Ömer]

Bende herhangi bir hata vermedi. Çalışmayan dosyanızı eklermisiniz. ( Kodları da ekleyerek ).Ayrıca küçük bir değişiklik yaptım, yalnız çalışması aynıdır.

2007 kullanıyorsanız Dosyayı farklı kaydet den "makro içerebilen dosya" şeklinde kaydetip deneyiniz.

 

[polis-53]

tarihe göre renklensin

dosya ekte

 

[Ömer]

CDate("31.01.2010")

Düzeltmiş fakat geç kalmışsım sanırım.

01 yerine 12 yazıp deneyiniz.

 

[polis-53]

ömer bey 31.12.2010 yaptım yine olmadı

 

[Ömer]

ömer bey 31.12.2010 yaptım yine olmadı

Kodlar sizin dosyada da, benim dosyamda da çalıştı.

Bu daha pratik ve hızlı bir kod. Döngü kurmadan yazdım.

Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim aralık As Range, gun As Integer
 
If Intersect(Target, [C:C,F:F]) Is Nothing Then Exit Sub
 
On Error GoTo sil
Set aralık = Range(Cells(Target.Row, Target.Column), _
    Cells(Target.Row, Target.Column - 2))
 
gun = DatePart("y", Target.Value, vbMonday)
aralık.Interior.ColorIndex = ((gun - 1) Mod 53) + 4
 
sil:
Range(Selection, Selection.Offset(0, -2)).Interior.ColorIndex = 0
 
End Sub

.

 

[polis-53]

tarih kapyaladığımda renklenmiyor

tekrar merhaba Ömer bey kodlar evdeki makinemde çalışmadı ama işyerimdeki makinede çalıştı çok teşekkur ederim sağolun ancak Tarihi yazınca renkleniyor yazdığım tarihi diğer hücrelere kopyaladığım zaman renklenmiyor bunuda yapabilirseniz çok sevineceğim kalın sağlıcakla.

 

[Ömer]

C:C yada F:F aralığındaki başka bir hücreye kopyalamadan bahsediyorsunuz sanırım.

Kod, hücre tetiklemesiyle çalıştığı için hücrede F2 enter yaparsanız çalışır. Yada bunun için kodu tekrar düzenlemek gerekir.

 

[polis-53]

hayır c:c f:f hucresine kopyalama yapacağım örneğin 01.01.2011 tarihi 10 sefer yazağım bunu ilgili hücrelere kopyalama yaptığımda renklenmiyor.

 

[Ömer]

Bende onu demek istedim.

Kod, hücre tetiklemesiyle çalıştığı için hücrede F2 enter yaparsanız çalışır. Yada bunun için kodu tekrar düzenlemek gerekir.

 

[polis-53]

F2 enter yaptığımıza tamam renkleniyor teker teker yazmaktan bir farkı olmuyor ben istiyorumki bir tarihi 5 vey 10 satıra c:c veya f:f hücresine kopyalama yaptığım an renklensin daha pratik olur düşünüyorum

 

[polis-53]

sayın ömer bey 16. mesajımdaki gibi olmuyormu olsa çok guzel olurdu.

 

[Ömer]

Olur yalnız verileri girdikten sonra buton ile kodu çalıştırmanız gerekir. Kopyalamayı tetikleyen kod varmı bilmiyorum. Bunu araştıracağım.

Toplu kontroller için buton ile işinizi görecekse hazırlayayım.

 

[polis-53]

aslında 16.mesaydaki gibi olsa daha güzel olurda olmuyorsada butonlada olur en azından şimdikindan dama pratik olur çok teşekkür ederim Allah ne muradın varsa versin kal sağlıcakla.

 

[Ömer]

Butona bağlayarak çalıştırınız.

Sub GuneGoreRenklendir()
 
Dim hucre As Range, SonSat As Long, Alan As Range
Dim aralık As Range, Renk As Integer, gun As Integer
 
Application.ScreenUpdating = False
    SonSat = Selection.SpecialCells(xlCellTypeLastCell).Row
    Range("A3:F" & SonSat).Interior.ColorIndex = xlNone
 
    Set Alan = Range("B3:E" & SonSat)
    Alan.SpecialCells(xlCellTypeConstants, 23).Select
 
    For Each hucre In Selection
        If IsDate(hucre.Offset(0, 1)) = True Then
            Set aralık = Range(hucre.Offset(0, -1).Address & ":" & _
            hucre.Offset(0, 1).Address)
            gun = DatePart("y", hucre.Offset(0, 1).Value, vbMonday)
            Renk = ((gun - 1) Mod 53) + 4
            aralık.Interior.ColorIndex = Renk
        End If
    Next hucre
 
[A1].Select
Application.ScreenUpdating = True
End Sub

.