• DİKKAT

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

Düşeyara veya başka bir yol ile sonraki en yakın tarihi bulmak

N

nongeyikm

Katılım
7 Kasım 2005
Mesajlar
505
Excel Vers. ve Dili
Office 365 TR-64
Merhabalar,

Düşeyara veya başka bir yol ile ekli çalışmada örneklediğim şekilde T.C. Kimlik numarası dikkate alınarak E sütununda belirtilen tarihlerden F sütununda yer alan en yakın tarihi bulmak istiyorum. 3.gündeyim aralıksız uğraşıyorum fakat nafile.

Saygılar,
 

Ekli dosyalar

Son düzenleme:
Verilerinizde ilk işe giriş için ilk işten çıkış tarihi olması gerekir. Yani en küçük işe giriş tarihinin eşi en küçük işten çıkış tarihi olması gerekir.
Verileriniz gerçekten bu düzende ise

E15 için
=KÜÇÜK($E$3:$E$10;SATIR(A1))

F15
=KÜÇÜK($F$3:$F$10;SATIR(A1))
 
Sn. ömer bey,

Verilerim aynen dediğiniz şekilde. Fakat C sütununda birlerce farklı T.C. kimlik numarası var. T.C. kimlik noya göre bunu yapmalı
 
ÖmerFaruk' Alıntı:
Verilerinizde ilk işe giriş için ilk işten çıkış tarihi olması gerekir. Yani en küçük işe giriş tarihinin eşi en küçük işten çıkış tarihi olması gerekir.
Verileriniz gerçekten bu düzende ise

E15 için
=KÜÇÜK($E$3:$E$10;SATIR(A1))

F15
=KÜÇÜK($F$3:$F$10;SATIR(A1))
Genişletmek için tıkla ...

Sn. ömer bey,

Verilerim aynen dediğiniz şekilde. Fakat C sütununda birlerce farklı T.C. kimlik numarası var. T.C. kimlik noya göre bunu yapmalı
 
Şayet yapılamıyor ise, T.C. Kimlik no lar dikkate alınarak sadece E sütunundaki tahihlere göre F sütununa formülü uygulamak yeterlidir.
 
Binlerce satırdan bahsettiğiniz için formülle kasacaktır. Bu sebepke VBA ile yaptım.
Dosyanız YeniListe isimli bir sayfa ekledim. Kodlar module1 içinde. Sayfaya 1 adet botun ekledim. Butona basınca kodları YeniListe isimli sayfada çalıştırabilirsiniz.
 

Ekli dosyalar

ÖmerFaruk' Alıntı:
Binlerce satırdan bahsettiğiniz için formülle kasacaktır. Bu sebepke VBA ile yaptım.
Dosyanız YeniListe isimli bir sayfa ekledim. Kodlar module1 içinde. Sayfaya 1 adet botun ekledim. Butona basınca kodları YeniListe isimli sayfada çalıştırabilirsiniz.
Genişletmek için tıkla ...

Ömer Bey merhaba,

Mükemmel bir şekilde çalıştı. bir bilgiyi eksik vermişim. Listede sarı font ile belirttiğim işten çıkış tarihi işe giriş tarihi ile aynı gün olan personeller de var. tek sorun bu. Ayrıca ekli sütunları da listeye ekleyebilir miyiz.

Not : Sadece merak ettiğim için soruyorum. Kasma sorunu dışında formül ile de yapılabilirliği var mıdır?

Saygılar,
 

Ekli dosyalar

Kodları aşağıdakiyle değiştirin.
C++: 
Sub YeniListe()
    Dim Sh As Worksheet
    Dim Dic1 As Object, Dic2 As Object, YeniListe As Object, Yeni
    Dim i As Integer, Son As Integer, k As Integer, x As Integer, Minimum As Date
   
    Set Dic1 = CreateObject("Scripting.Dictionary")
    Set Dic2 = CreateObject("Scripting.Dictionary")
    Set YeniListe = CreateObject("Scripting.Dictionary")
    Set Sh = Worksheets("Sayfa1")
    Son = Sh.Range("C" & Rows.Count).End(3).Row
    If Son < 3 Then MsgBox "Veriler Eksik": Exit Sub
    Worksheets("YeniListe").Range("C3:H" & Rows.Count).ClearContents
    Dizi = Sh.Range("A3").Resize(Son - 2, 8).Value
    For i = 1 To UBound(Dizi)
        If Dizi(i, 7) <> "" Then
            If Not Dic1.Exists(Dizi(i, 3)) Then
                Dic1.Add Dizi(i, 3), i
            Else
                Dic1(Dizi(i, 3)) = Dic1(Dizi(i, 3)) & "--" & i
            End If
        End If
        If Dizi(i, 8) <> "" Then
            If Not Dic2.Exists(Dizi(i, 3)) Then
                Dic2.Add Dizi(i, 3), i
            Else
                Dic2(Dizi(i, 3)) = Dic2(Dizi(i, 3)) & "--" & i
            End If
        End If
    Next i
    ReDim Liste(1 To Rows.Count, 1 To 8)
    For i = 0 To Dic1.Count - 1
        For k = 0 To UBound(Split(Dic1.items()(i), "--"))
            Say = Say + 1
            Liste(Say, 1) = Dizi(Split(Dic1.items()(i), "--")(0), 1)
            Liste(Say, 2) = Dizi(Split(Dic1.items()(i), "--")(0), 2)
            Liste(Say, 3) = Dizi(Split(Dic1.items()(i), "--")(0), 3)
            Liste(Say, 4) = Dizi(Split(Dic1.items()(i), "--")(0), 4)
            Liste(Say, 5) = Dizi(Split(Dic1.items()(i), "--")(0), 5)
            Liste(Say, 6) = Dizi(Split(Dic1.items()(i), "--")(0), 6)
            Liste(Say, 7) = Dizi(Split(Dic1.items()(i), "--")(k), 7)
            YeniListe.RemoveAll
            If Dic2.Exists(Dic1.Keys()(i)) Then
                Yeni = Split(Dic2(Dic1.Keys()(i)), "--")
                Minimum = 0
                For x = 0 To UBound(Yeni)
                    YeniListe.Add Yeni(x), 1
                    If Liste(Say, 7) <= Dizi(Yeni(x), 8) Then
                        If Minimum = 0 Then
                            Minimum = Dizi(Yeni(x), 8)
                        Else
                            Minimum = WorksheetFunction.Min(Minimum, Dizi(Yeni(x), 8))
                        End If
                    End If
                Next x
                If Minimum > 0 Then
                    For x = 1 To YeniListe.Count
                        If Minimum = YeniListe.Keys()(x - 1) Then YeniListe.Remove Minimum: Exit For
                    Next x
                    Liste(Say, 8) = Minimum
                    Dic2(Dic1.Keys()(i)) = Join(YeniListe.Keys, "--")
                End If
            End If
        Next k
    Next i
    Worksheets("YeniListe").Range("A3").Resize(Say, 8) = Liste
End Sub


Eğer İŞYERİ SGK nosunda "-" den sonraki kısmı kayıt etmeyeceksiniz aşağıdaki satırda gösterdiğim düzeltmeyi yapabilirsiniz.,
Liste(Say, 2) = Dizi(Split(Dic1.items()(i), "--")(0), 2)
Liste(Say, 2) = Split(Dizi(Split(Dic1.items()(i), "--")(0), 2), "-")(0)

Ve YeniListe sayfasındaki B sütununu METİN olarak formatlayın.
 
ÖmerFaruk' Alıntı:
Kodları aşağıdakiyle değiştirin.
C++: 
Sub YeniListe()
    Dim Sh As Worksheet
    Dim Dic1 As Object, Dic2 As Object, YeniListe As Object, Yeni
    Dim i As Integer, Son As Integer, k As Integer, x As Integer, Minimum As Date
 
    Set Dic1 = CreateObject("Scripting.Dictionary")
    Set Dic2 = CreateObject("Scripting.Dictionary")
    Set YeniListe = CreateObject("Scripting.Dictionary")
    Set Sh = Worksheets("Sayfa1")
    Son = Sh.Range("C" & Rows.Count).End(3).Row
    If Son < 3 Then MsgBox "Veriler Eksik": Exit Sub
    Worksheets("YeniListe").Range("C3:H" & Rows.Count).ClearContents
    Dizi = Sh.Range("A3").Resize(Son - 2, 8).Value
    For i = 1 To UBound(Dizi)
        If Dizi(i, 7) <> "" Then
            If Not Dic1.Exists(Dizi(i, 3)) Then
                Dic1.Add Dizi(i, 3), i
            Else
                Dic1(Dizi(i, 3)) = Dic1(Dizi(i, 3)) & "--" & i
            End If
        End If
        If Dizi(i, 8) <> "" Then
            If Not Dic2.Exists(Dizi(i, 3)) Then
                Dic2.Add Dizi(i, 3), i
            Else
                Dic2(Dizi(i, 3)) = Dic2(Dizi(i, 3)) & "--" & i
            End If
        End If
    Next i
    ReDim Liste(1 To Rows.Count, 1 To 8)
    For i = 0 To Dic1.Count - 1
        For k = 0 To UBound(Split(Dic1.items()(i), "--"))
            Say = Say + 1
            Liste(Say, 1) = Dizi(Split(Dic1.items()(i), "--")(0), 1)
            Liste(Say, 2) = Dizi(Split(Dic1.items()(i), "--")(0), 2)
            Liste(Say, 3) = Dizi(Split(Dic1.items()(i), "--")(0), 3)
            Liste(Say, 4) = Dizi(Split(Dic1.items()(i), "--")(0), 4)
            Liste(Say, 5) = Dizi(Split(Dic1.items()(i), "--")(0), 5)
            Liste(Say, 6) = Dizi(Split(Dic1.items()(i), "--")(0), 6)
            Liste(Say, 7) = Dizi(Split(Dic1.items()(i), "--")(k), 7)
            YeniListe.RemoveAll
            If Dic2.Exists(Dic1.Keys()(i)) Then
                Yeni = Split(Dic2(Dic1.Keys()(i)), "--")
                Minimum = 0
                For x = 0 To UBound(Yeni)
                    YeniListe.Add Yeni(x), 1
                    If Liste(Say, 7) <= Dizi(Yeni(x), 8) Then
                        If Minimum = 0 Then
                            Minimum = Dizi(Yeni(x), 8)
                        Else
                            Minimum = WorksheetFunction.Min(Minimum, Dizi(Yeni(x), 8))
                        End If
                    End If
                Next x
                If Minimum > 0 Then
                    For x = 1 To YeniListe.Count
                        If Minimum = YeniListe.Keys()(x - 1) Then YeniListe.Remove Minimum: Exit For
                    Next x
                    Liste(Say, 8) = Minimum
                    Dic2(Dic1.Keys()(i)) = Join(YeniListe.Keys, "--")
                End If
            End If
        Next k
    Next i
    Worksheets("YeniListe").Range("A3").Resize(Say, 8) = Liste
End Sub


Eğer İŞYERİ SGK nosunda "-" den sonraki kısmı kayıt etmeyeceksiniz aşağıdaki satırda gösterdiğim düzeltmeyi yapabilirsiniz.,
Liste(Say, 2) = Dizi(Split(Dic1.items()(i), "--")(0), 2)
Liste(Say, 2) = Split(Dizi(Split(Dic1.items()(i), "--")(0), 2), "-")(0)

Ve YeniListe sayfasındaki B sütununu METİN olarak formatlayın.
Genişletmek için tıkla ...



Ömer FARUK Bey merhaba,

Çalışmanızı dünden beri deniyorum.

Aynı T.C. Kimlik noya sahip olan kişi farklı dönemlerde her 2 firmada da çalışması var. (farklı tarih aralıklarında. 2 ayrı firmanın dönemlerinde tarih çakışması yok)

makronuzda tüm çalışmasını tek bir firmada gösteriyor. (A ve B sütunlarını dikkate almıyor.)

Müsait zamanınızda bakabilir misiniz?

Saygılar,
 

Ekli dosyalar

Son düzenleme:
Konu tamamen farklı bir durum aldı. Müsait bir zamanımda bakabilirim.
 
Merhaba,

Ekli dosyadaki hatayı giderebilmek için zamanınız var mı? Kişi farklı işyerlerinde çalışması var. Aslında tarihler doğru şekilde geliyor fakat tarih dışındaki diğer veriler hatalı geliyor.

Saygılar,
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst