Tarihi geçen hücreyi yeni tarihiyle en alta atma ?

[reallerking]

[/url][/IMG]

Merhaba arkadaşlar resimde ki gibi bir tablom mevcut. Tarihi gelen hücreleri bütünüyle en alt satıra yeni tarihleriyle nasıl atabilirim ? Burada sanırım makro devreye girecek. Örnek vermem gerekir ise 01.03.2017 tarihli bir hücrem tarihi geldiğinde 01.03.2018 olarak diğer verileriyle birlikte en alt satıra gitsin istiyorum. Yardımlarınızı bekliyorum, şimdiden teşekkürler...

 

[çıtır]

İsterseniz satır ve sütun gizleyerek makrosuz yapılabilir.
Makro olarak sayfanın kod kısmına:

Private Sub Worksheet_Activate()
Dim i As Integer, satir As Integer
Application.ScreenUpdating = False
On Error Resume Next
satir = Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To satir
If Range("c" & i) <> "" And Range("c" & i).Value <= Date Then
Range("c" & i) = WorksheetFunction.EDate(Range("c" & i), 12)
End If
 Next i
 Range("A3:C" & satir).Select
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add Key:=Range("C3:C" & satir) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sayfa1").Sort
        .SetRange Range("A3:C" & satir)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    For i = 3 To satir
   If Range("c" & i) <> "" Then
Range("d" & i) = Range("c" & i) - Date & " GÜN KALDI"

End If
Next i
    Range("D3").Select
    Application.ScreenUpdating = True
End Sub

 

[assenucler]

Teşekkür ve bir istek

Sayın Çıtır,


Günaydın.

İlgi duyduğum için dosyayı indirdim.

Kasko tarihi geçenler için " 10 GÜN GEÇTİ" şeklinde, gün sayısı değişen bir açıklama için, koda nasıl bir ekleme yapmak gerekiyor?

Yardımınız için teşekkürler.

Sevgi ve saygılar.

 

[çıtır]

For i = 3 To satir
If Range("c" & i) <> "" And Range("c" & i).Value <= Date Then
Range("c" & i) = WorksheetFunction.EDate(Range("c" & i), 12)
End If
Next i
1. For i Silinmelidir.

2. next i den önce ilave edilmelidir.

If Range("c" & i) <> "" And Range("C" & i) < Date Then
Range("d" & i) = (Range("c" & i) - Date) * -1 & " GÜN GEÇTİ"
End If
If Range("c" & i) <> "" And Range("C" & i) = Date Then
Range("d" & i) = " KASKO GÜNÜ"
End If

 

[reallerking]

Çıtır kardeşim tekrar eline sağlık Makrosuz yapmak istesek nasıl yapabiliriz ? Bu kodları çalıştırdım ama bir değişiklik olmuyor gibi bir yerde hata yapıyorum sanırım. Yeni tarih giriyorum mesela bugünün veya daha önceki bir günün herhangi bir değişiklik olmuyor. .... Gün Kaldı kısmını kullanarak <=0 diyerek tarihe +1 yıl eklemek yoluyla yapmak nasıl olurdu ? dosyayı ekliyeyim daha yardımcı olabilir...Teşekkür ediyorum tekrar...https://sheet.zoho.com/sheet/ropen.do?rid=1djdr94f079b66edc43468a487852c9bb01b7

 

[assenucler]

Sayın çıtır,


Öncelikle ilginiz için teşekkürler.

Açıklamanıza göre yanlış yaptığım bir şey olmalı, hata iletisi aldım.

Dosya ilişiktedir.

 

[çıtır]

Tablonuz uygun olmayabilir.sayfa adı uygun olmayabilir. Sayfa değiştirip açtığınızda kodlar çalışıp değişiklik olur. Resim ekliyorum.


http://i.hizliresim.com/bkq3Wn.png

http://i.hizliresim.com/X9VQB3.png

 

[assenucler]

Pencere resmini ekliyorum. Tablo yapısı ve sayfa1 adı sizin resminizdeki gibidir.


Kod sayfa resmi:

http://i.hizliresim.com/ad9Oj4.png

 

[çıtır]

Silinmeyen kısım var.Resmi ekledim , yeşil kısım silinecek.

 

[assenucler]

Sayın çıtır,


İnşallah beni yanlış anlamamışınızdır.6. iletide de değindim "yanlış yaptığım bir şey olmalı" diye.

Sorun çözüldü. Sağ olun var olun. Her şey gönlünüzce olsun.

 

[çıtır]

Sayın çıtır,


İnşallah beni yanlış anlamamışınızdır.6. iletide de değindim "yanlış yaptığım bir şey olmalı" diye.

Sorun çözüldü. Sağ olun var olun. Her şey gönlünüzce olsun.

Sizin de her şey gönlünüzce olsun bilmukabele ,sorunun çözüldüğüne memnun oldum. Güzel temennileriniz için teşekkürler.

 

[çıtır]

Makrosuz; ilk tabloyu ve A sütunun gizle

http://s9.dosya.tc/server2/s8kwvh/ss6.rar.html

 

[reallerking]

İlk tabloyu ve A sütununu gizleyerek yapmayı denedim ama bir değişiklik olmadı. Elle tarih giriyorum denemek amaçlı herhangi bir değişiklik yok. Makroyu deniyorum tek değişiklik plakaların yerleri değişiyor farklı plaka farklı bir tarihe geçiyor. Tarihte herhangi bir değişiklik olmuyor. Bir yerde hata yapıyorum ama nerede ? Plaka sütununa hücre biçimlendirden 64 ön sayısını otomatik attıyorum bunun bir önemi olabilir belki yardımını bekliyorum çıtır kardeşim yoruyoruz seni hakkını helal et

 

[çıtır]

isteğiniz bu:
Örnek vermem gerekir ise 01.03.2017 tarihli bir hücrem tarihi geldiğinde 01.03.2018 olarak diğer verileriyle birlikte en alt satıra gitsin istiyorum.

1)Kalan günü otomatik olarak gösterir.

2)Günün tarihini girerseniz 1 yıl sonraki tarihi atar ve en son satıra diğer verileriyle birlikte gider.15.02.2017 tarihini girerek deneyin. örn. baştaki plakaya 15.02.2017 tarihini girin makroda başka sayfayı örn 2. sayfa aç tekrar sayfayı aç. değişir. diğer verileriyle en alt satıra gider ve 15.02.2018 olur.

3)Makrosuzda ilk 1.tabloda ilk plakaya günün tarihini yaz. 2.tabloda en alt satıra gider ve kalan günleri gösterir.

 

[reallerking]

Private Sub Worksheet_Activate()
Dim i As Integer, satir As Integer
Application.ScreenUpdating = False
On Error Resume Next
satir = Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To satir
If Range("c" & i) <> "" And Range("c" & i).Value <= Date Then
Range("c" & i) = WorksheetFunction.EDate(Range("c" & i), 12)
End If
 Next i
 Range("A3:C" & satir).Select
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sayfa1").Sort.SortFields.Add Key:=Range("C3:C" & satir) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sayfa1").Sort
        .SetRange Range("A3:C" & satir)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    For i = 3 To satir
   If Range("c" & i) <> "" Then
Range("d" & i) = Range("c" & i) - Date & " GÜN KALDI"

End If
Next i
    Range("D3").Select
    Application.ScreenUpdating = True
End Sub

Bunu kullanarak çalıştırdığımda plakaların yerleri değişiyor. Plakaların kendi tarihlerini çekemiyor farklı plaka farklı tarihe kayıyor. 15.02.2017 veya daha önceki bir tarihi yazıyorum sayfayı yeniliyorum fakat tarihi en alta atmıyor veya 2018 olmuyor. Sütun isimlerinde bir sıkıntı olma ihtimali var mı ? Makrolu olan daha kullanışlı olacak benim için bunun için yoruyorum seni. Makrosuz olan çalışıyor onda sıkıntı yok.

 

[çıtır]

Tablonuz A sütunu 2 satırdan başlamalı.Tablo resmini daha önce gönderdim.bu resme bakınız.

 

[reallerking]

Kodsuz hali yani benim kullandığım hali bu.

[/url][/IMG]

Kodu kullanıyorum çalıştırıyorum sayfayı yeniliyorum ve durum bu. Elle tarih giriyorum denemek için herhangi bir değişiklik olmuyor dediğim gibi de plakaların yerleri değişirken kendi tarihlerini çekemiyor tarihler karışıyor.

[/url][/IMG]

[/url][/IMG]

Sorunu çözmek adına gösteriyorum sayfa 2'den a sütununa veri listesi uyguluyorum. Sorun bununla alakalı olabilir mi ?

[/url][/IMG]

 

[çıtır]

Hücre birleştirmesi yapıldı mı? Hücre birleştirmesi var ise kod buna göre düzenlenmelidir veya tabloda hücre birleştirmesi yapma . Sorun kodları yanlış yere yapıştırılmış.VBA projette Sayfa(Sayfa1) i çift tıkla.(Genaral) den Worksheet seç araya kodları yapıştır. Kolay gelsin sonuç bildir.teşekkür ederim resim ekledim.

http://i.hizliresim.com/ZZgLQV.png

 

[reallerking]

Evet şimdi oldu Tekrar teşekkürler çıtır kardeşim +rep falan da yok forumda vereyim hak ediyorsun. Emeğine sağlık...

 

[çıtır]

teşekkürler

Senin canın sağ olsun.Önemli olan sorunların çözülerek, insanların mutlu olması.Sağlık,mutluluk ve başarılar dilerim.