Yakın tarihlere göre sıralama (Çok sütunlu)

[angloth]

İyi günler arkadaşlar.

Excel de ilk sayfada göründüğü üzere kişilerin tarihlerini orada sarıya boyadığım sütunlardan takip ediyorum ama bu sarıya boyamış olduğum sütunlarda tarihi geleni diğer sayfada tarih sıralı olarak tarihi en yakın olana göre sıralamasını istiyorum. şimdiden yardımlarınız için teşekkür ederim.

http://s7.dosya.tc/server3/sgbqmt/Takip1.xlsx.html

 

[Ömer BARAN]

Merhaba, foruma hoşgeldiniz.

-- Disiplin- Firar Takip veya GÜNÜ GELEN sayfasına 1 adet METİN KUTUSU/ŞEKİL ekleyin,
-- ALT+F11 tuşlarına basarak VBA ekranının açılmasını sağlayın,
-- Açılan VBA ekranında üstteki MENÜ kısmından INSERT=>MODULEyi seçin,
-- Aşağıdaki kod blokunu sağdaki boş alana yapıştırın.
-- Sayfaya eklediğiniz METİN KUTUSUNA/ŞEKİLE fareyle sağ tıklayıp MAKRO ATAyı seçin,
-- Açılacak küçük ekranda, TARIH_SIRALI_ISLEMLER makrosunun adını seçerek işlemi onaylayın.

Artık sayfaya eklediğiniz bu ŞEKİL/METİN KUTUSUna fareyle tıkladığınızda istediğiniz işlem gerçekleşecektir.
.

[B][COLOR="blue"]Sub TARIH_SIRALI_ISLEMLER()[/COLOR][/B]
Set dft = Sheets("Disiplin- Firar Takip"): Set gg = Sheets("GÜNÜ GELEN")
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
son = dft.Cells(Rows.Count, 1).End(3).Row
If gg.Cells(Rows.Count, 1).End(3).Row > 1 Then gg.Range("A2:D" & Rows.Count).Clear
For sut = 5 To 18
    If sut = 8 Then sut = 10
    If sut = 12 Then sut = 14
    If sut = 15 Then sut = 18
    ggson = gg.Cells(Rows.Count, 1).End(3).Row + 1
    dft.Range("A2:B" & son).Copy: gg.Cells(ggson, 1).PasteSpecial Paste:=xlPasteValues
    dft.Range(dft.Cells(2, sut), dft.Cells(son, sut)).Copy: gg.Cells(ggson, 3).PasteSpecial Paste:=xlPasteValues
    dft.Cells(1, sut).Copy: gg.Range(gg.Cells(ggson, 4), gg.Cells(ggson + son - 2, 4)).PasteSpecial Paste:=xlPasteValues
Next
    For sat = gg.Cells(Rows.Count, "A").End(3).Row To 2 Step -1
        If Cells(sat, 3) = "" Then Rows(sat & ":" & sat).Delete Shift:=xlUp
        If Cells(sat, 3) <> "" Then Cells(sat, "C") = CDate(Cells(sat, "C").Text)
    Next
gg.Range("A2:D" & gg.Cells(Rows.Count, 1).End(3).Row).Sort key1:=gg.[C2], Order1:=1
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
gg.Columns("A:D").AutoFit: gg.Columns("C:C").HorizontalAlignment = xlCenter: gg.Activate: gg.[A1].Activate
MsgBox "İşlem Tamamlandı.", vbInformation, "..::.. Ömer BARAN ..::.."
[B][COLOR="Blue"]End Sub[/COLOR][/B]

 

[angloth]

yardımlarınız için teşekkür ederim.

 

[angloth]

kardeşim yalnız bir durum var sarı sütunda olanlar hariç diğerlerinde bulunan tarihleri de listeye çıkartıyor.

 

[Ömer BARAN]

Önceki kod cevabımda, ayrı ayrı satırlarda yer alması gereken 3 adet If.... satırını tek satırda birleştirmişim,
onların ayrı satırlarda olması lazım idi. Bir de +1 ve sayfa adı belirtmeyi unutmuşum onu ekledim.
Sayfayı yenileyerek önceki cevabımı kontrol edin, değişiklikleri kırmızı renklendirdim.

 

[angloth]

Çok teşekkür ederim kardeşim. ellerine sağlık.

 

[Ömer BARAN]

Eyvallah, iyi çalışmalar ve başarılar dilerim.

 

[Ömer BARAN]

Tekrar merhaba.

METİN/TARİH sorununu da halledeyim dedim. Disiplin- Firar Takip sayfasındaki tarih formllerinizi değiştirmenize gerek yok.
Sayfayı yenileyerek önceki kod cevabımı kontrol edip yeni halini kullanmanızı öneriyorum.
.

 

[angloth]

kodda hata veriyor kardeşim yapmıyor. Then Cells(sat, "C") = CDate(Cells(sat, "C").Text) kısmını hatalı gösteriyor.

 

[Ömer BARAN]

İşlemin uygulandığı belgeye, fareyle buraya tıklayarak erişebilirsiniz.
İşlem için, GÜNÜ GELEN sayfasındaki düğmeleri kullanabilirsiniz.
.

 

[angloth]

kardeşim çok teşekkür ederim. Eğer mümkün ise bunu yaptığımız GÜNÜ GELEN sayfasında bugünün tarihinden üç gün önce ve üç gün sonra gelen tarihlerin olduğu satırlarda farklı renk (bugün 25/02/2018 olsun. 24 - 23 ve 22 si ni farklı tek renk, 26 - 27 ve 28 ini farklı tek renk koyu yazıların altı çizili olarak) ve bugün olan tarihli satırları da kırmızı renkli yazıların altı çizili koyu olarak gösterebilir miyiz. tekrardan teşekkür ederim.

 

[Ömer BARAN]

Merhaba.

Ekteki belgeyi inceleyin, gerçek verilerle denemeler yapın.
Ekteki belgeye, fareyle buraya tıklayarak da erişebilirsiniz.
.

 

[angloth]

Çok teşekkür ederim. Yeni denedim. Elinize sağlık

 

[Ömer BARAN]

Aslında üzerinden bu kadar gün geçmiş cevaba geri dönüş yapılmadığında verdiğim cevabı siliyordum
ama KAMU GÖREVLİSİ olmanız hasebiyle silmemiştim ve olayın, geri dönüşte bulunmama olmadığını,
basit bir unutma olduğunu varsaymıştım.

Yanılmamışım demek ki.

İyi çalışmalar dilerim.
.