• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

A

angloth

Katılım
21 Şubat 2018
Mesajlar
59
Excel Vers. ve Dili
2010
İ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
 
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.
.
Kod: 
[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]
 
kardeşim yalnız bir durum var sarı sütunda olanlar hariç diğerlerinde bulunan tarihleri de listeye çıkartıyor.
 
Ö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.
 
Eyvallah, iyi çalışmalar ve başarılar dilerim.
 
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.
.
 
kodda hata veriyor kardeşim yapmıyor. Then Cells(sat, "C") = CDate(Cells(sat, "C").Text) kısmını hatalı gösteriyor.
 
İşlemin uygulandığı belgeye, fareyle buraya tıklayarak erişebilirsiniz.
İşlem için, GÜNÜ GELEN sayfasındaki düğmeleri kullanabilirsiniz.
.
 
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.
 
Merhaba.

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

Ekli dosyalar

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.
.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst