Sıralı İzin Tarihlerini Yanyana Alma?

[baykan_m]

Merhaba Arkadaşlar,

Ekteki tablo pdks programından çektiğim izin raporudur. Raporda görüleceği gibi A kişisinin izinlerini gün gün alt alta yazıyor. Benim istediğim A kişisine ait izin aralığının aşağıdaki örnekteki gibi yazmak.

Örnek:
1 - A Kişisi - 01.12.2020 - 31.12.2020 - ÜCRETSİZ (4 ayrı sütunda)
2 - B Kişisi - 15.10.2020 - 15.10.2020 - YILLIK (4 ayrı sütunda)

Yardımcı olan arkadaşlara şimdiden teşekkür ederim.

İyi çalışmalar

 

[ÖmerFaruk]

Aynı sayfada G-H-I-J sütunlarına yazdırdım.
Sonuçların bir kısmını kontrol ettim. Siz de kontrol edip hata varsa söylerseniz düzeltirim.

Sub İzinler()
Dim Tarih
satır = 1
For i = 2 To Cells(2, 3).End(xlDown).Row
    For k = 1 To Len(Range("C" & i))
        If Mid(Range("C" & i), k, 1) Like "#" Then
            Tarih = Right(Range("C" & i), Len(Range("C" & i)) - k + 1)
            ix = InStr(1, Tarih, " ")
            Tarih = CDate(Left(Tarih, ix - 1))
            GoTo Devam
        End If
    Next k
Devam:

    If Range("A" & i) <> "" Then
        satır = satır + 1
        Range("G" & satır) = Range("A" & i) & " " & Range("B" & i)
        Range("H" & satır) = Tarih
        Range("I" & satır) = Tarih
        Range("J" & satır) = Range("D" & i)
        GoTo 10
    End If
    If (Tarih - Range("H" & satır) = 1) And (Range("D" & i) = Range("D" & i - 1)) Then
        Range("I" & satır) = Tarih
        GoTo 10
    End If
        If (Tarih - Range("I" & satır) = 1) And (Range("D" & i) = Range("D" & i - 1)) Then
        Range("I" & satır) = Tarih
        GoTo 10
    End If
    If (Tarih - Range("H" & satır) > 1) And (Range("D" & i) = Range("D" & i - 1)) Then
        satır = satır + 1
        Range("G" & satır) = Range("G" & satır - 1)
        Range("H" & satır) = Tarih
        Range("I" & satır) = Tarih
        Range("J" & satır) = Range("D" & i)
        GoTo 10
    End If
    If (Range("D" & i) <> Range("D" & i - 1)) Then
        satır = satır + 1
        Range("G" & satır) = Range("G" & satır - 1)
        Range("H" & satır) = Tarih
        Range("I" & satır) = Tarih
        Range("J" & satır) = Range("D" & i)
        GoTo 10
    End If
10
 Next i
End Sub

 

[baykan_m]

Aynı sayfada G-H-I-J sütunlarına yazdırdım.
Sonuçların bir kısmını kontrol ettim. Siz de kontrol edip hata varsa söylerseniz düzeltirim.

Sub İzinler()
Dim Tarih
satır = 1
For i = 2 To Cells(2, 3).End(xlDown).Row
    For k = 1 To Len(Range("C" & i))
        If Mid(Range("C" & i), k, 1) Like "#" Then
            Tarih = Right(Range("C" & i), Len(Range("C" & i)) - k + 1)
            ix = InStr(1, Tarih, " ")
            Tarih = CDate(Left(Tarih, ix - 1))
            GoTo Devam
        End If
    Next k
Devam:

    If Range("A" & i) <> "" Then
        satır = satır + 1
        Range("G" & satır) = Range("A" & i) & " " & Range("B" & i)
        Range("H" & satır) = Tarih
        Range("I" & satır) = Tarih
        Range("J" & satır) = Range("D" & i)
        GoTo 10
    End If
    If (Tarih - Range("H" & satır) = 1) And (Range("D" & i) = Range("D" & i - 1)) Then
        Range("I" & satır) = Tarih
        GoTo 10
    End If
        If (Tarih - Range("I" & satır) = 1) And (Range("D" & i) = Range("D" & i - 1)) Then
        Range("I" & satır) = Tarih
        GoTo 10
    End If
    If (Tarih - Range("H" & satır) > 1) And (Range("D" & i) = Range("D" & i - 1)) Then
        satır = satır + 1
        Range("G" & satır) = Range("G" & satır - 1)
        Range("H" & satır) = Tarih
        Range("I" & satır) = Tarih
        Range("J" & satır) = Range("D" & i)
        GoTo 10
    End If
    If (Range("D" & i) <> Range("D" & i - 1)) Then
        satır = satır + 1
        Range("G" & satır) = Range("G" & satır - 1)
        Range("H" & satır) = Tarih
        Range("I" & satır) = Tarih
        Range("J" & satır) = Range("D" & i)
        GoTo 10
    End If
10
Next i
End Sub

Çok teşekkür ederim tam istediğim gibi olmuş, ellerinize sağlık