(15/11/2023, 16:05)cdenktas yazdı:

(14/11/2023, 23:26)feraz yazdı: Rica ederim.
Tarihler ve görev değişince kod çalışır gifteki gibi.

PHP Kod:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long, son As Long, say As Long
    Dim syf As Worksheet
    
    On Error Resume Next
    Set syf = ThisWorkbook.Worksheets(Range("I1").Value)
    On Error GoTo 0
    
    If Not Intersect(Target, Union(Range("B2"), Range("F2"), Range("I1"))) Is Nothing Then
        say = 5
        Union(Range("B5:C" & Rows.Count), Range("E5:E" & Rows.Count)).Value = ""
        If Trim(Target.Value) <> "" And Not syf Is Nothing Then
            With syf
                For i = 2 To .Cells(Rows.Count, "A").End(3).Row + 1
                    If (.Cells(i, "B").Value2) >= Cells(2, "B").Value2 And (.Cells(i, "C").Value2 <= Cells(2, "F").Value2) Then
                        Range("B" & say).Value = .Cells(i, "B").Value
                        Range("C" & say).Value = .Cells(i, "C").Value
                        Range("E" & say).Value = .Cells(i, "A").Value
                        say = say + 1
                    End If
                Next
            End With
        End If
    End If
    Set syf = Nothing
End Sub 


Merhabalar, ilginiz ve emeğiniz için çok teşekkür ederim,

Benim gözümden kaçan bir husus varmış, kusura bakmayın. Kişi iş başlama tarihi örnek yazmış olduğumuz iş başlama -iş bitiş tarihi arasında olduğunda, o satırdaki ilgili firma ismi ve başlangıç tarihi benim gri kısımdaki işe başlangıç tarihi ile başlayacak.

Örneğin kişi işe başlama tarihi 18.05.2005 başladığında

a 16.05.2005 31.05.2005 iki tarih arasında oluyor ve işe başlangıç tarihim 18.05.2005 olup iş bitiş tarihide 31.05.2005 olması gerekiyor..

Yani bitiş tarihi ayın sonumu olacak devamı mesela 28 inde başlasa 31 yada 30 umu gelecek şubat hariç.

Tam anlaşılması için B2 ye 01.07.2005 ve F2 ye 31.12.2008 ve I1 e veri girişi seçip listele yapın ve sonucu sayfada resim olarak foruma atın son eklediğim dosyaya göre ona göre bakalım.

(16/11/2023, 01:30)feraz yazdı: Tam anlaşılması için B2 ye 01.07.2005 ve F2 ye 31.12.2008 ve I1 e veri girişi seçip listele yapın ve sonucu sayfada resim olarak foruma atın son eklediğim dosyaya göre ona göre bakalım.

[img][/img]

Resimden anladığım kadarıyla B5 e giriş(B2) C deki son tarihede çıkış tarihi yazılacak F2 deki.

(16/11/2023, 11:58)feraz yazdı: Resimden anladığım kadarıyla B5 e giriş(B2) C deki son tarihede çıkış tarihi yazılacak F2 deki.

PHP Kod:

Private Sub CommandButton1_Click()
    Dim i As Long, son As Long, say As Long
    Dim syf As Worksheet
    
    On Error Resume Next
    Set syf = ThisWorkbook.Worksheets(Range("I1").Value)
    On Error GoTo 0
    
    say = 5
    Union(Range("B5:C" & Rows.Count), Range("E5:E" & Rows.Count)).Value = ""
    If Not syf Is Nothing Then
        With syf
            For i = 2 To .Cells(Rows.Count, "A").End(3).Row + 1
                If (.Cells(i, "B").Value2) >= Cells(2, "B").Value2 And (.Cells(i, "C").Value2 <= Cells(2, "F").Value2) Then
                    Range("B" & say).Value = .Cells(i, "B").Value
                    Range("C" & say).Value = .Cells(i, "C").Value
                    Range("E" & say).Value = .Cells(i, "A").Value
                    If say = 5 Then Range("B5").Value = Range("B2").Value
                    say = say + 1
                End If
            Next
        End With
    End If
    If say > 5 Then Range("C" & say - 1).Value = Range("F2").Value
    Set syf = Nothing
End Sub 


Kusura bakmayın, emeğinize sağlık, çok teşekkür ederim. Ufak bir yerde sorun var. Resmi atıyorum.

(17/11/2023, 09:25)cdenktas yazdı: [quote="feraz" pid="191106" dateline="1700125099"]
Resimden anladığım kadarıyla B5 e giriş(B2) C deki son tarihede çıkış tarihi yazılacak F2 deki.

PHP Kod:

Private Sub CommandButton1_Click()
    Dim i As Long, son As Long, say As Long
    Dim syf As Worksheet
    
    On Error Resume Next
    Set syf = ThisWorkbook.Worksheets(Range("I1").Value)
    On Error GoTo 0
    
    say = 5
    Union(Range("B5:C" & Rows.Count), Range("E5:E" & Rows.Count)).Value = ""
    If Not syf Is Nothing Then
        With syf
            For i = 2 To .Cells(Rows.Count, "A").End(3).Row + 1
                If (.Cells(i, "B").Value2) >= Cells(2, "B").Value2 And (.Cells(i, "C").Value2 <= Cells(2, "F").Value2) Then
                    Range("B" & say).Value = .Cells(i, "B").Value
                    Range("C" & say).Value = .Cells(i, "C").Value
                    Range("E" & say).Value = .Cells(i, "A").Value
                    If say = 5 Then Range("B5").Value = Range("B2").Value
                    say = say + 1
                End If
            Next
        End With
    End If
    If say > 5 Then Range("C" & say - 1).Value = Range("F2").Value
    Set syf = Nothing
End Sub 


Kusura bakmayın, emeğinize sağlık, çok teşekkür ederim. Ufak bir yerde sorun var. Resmi atarken bir sorun oldu, zip dosya atıyorum...