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
Altın Üyelik Bitiş Tarihi
15-04-2025
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:
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,801
Excel Vers. ve Dili
Microsoft 365 Tr-64
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))
 
N

nongeyikm

Katılım
7 Kasım 2005
Mesajlar
505
Excel Vers. ve Dili
Office 365 TR-64
Altın Üyelik Bitiş Tarihi
15-04-2025
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ı
 
N

nongeyikm

Katılım
7 Kasım 2005
Mesajlar
505
Excel Vers. ve Dili
Office 365 TR-64
Altın Üyelik Bitiş Tarihi
15-04-2025
Ö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ı
 
N

nongeyikm

Katılım
7 Kasım 2005
Mesajlar
505
Excel Vers. ve Dili
Office 365 TR-64
Altın Üyelik Bitiş Tarihi
15-04-2025
Ş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.
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,801
Excel Vers. ve Dili
Microsoft 365 Tr-64
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

N

nongeyikm

Katılım
7 Kasım 2005
Mesajlar
505
Excel Vers. ve Dili
Office 365 TR-64
Altın Üyelik Bitiş Tarihi
15-04-2025
Ö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

ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,801
Excel Vers. ve Dili
Microsoft 365 Tr-64
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.
 
N

nongeyikm

Katılım
7 Kasım 2005
Mesajlar
505
Excel Vers. ve Dili
Office 365 TR-64
Altın Üyelik Bitiş Tarihi
15-04-2025
Ö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:
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,801
Excel Vers. ve Dili
Microsoft 365 Tr-64
Konu tamamen farklı bir durum aldı. Müsait bir zamanımda bakabilirim.
 
N

nongeyikm

Katılım
7 Kasım 2005
Mesajlar
505
Excel Vers. ve Dili
Office 365 TR-64
Altın Üyelik Bitiş Tarihi
15-04-2025
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.
Üst