İki tarih arasındaki günleri getirme

[ordulu82]

Selamlar
listede kişinin farklı zamanlarda almış olduğu izinler var. Ben bu izin tarihleri arasındaki günleri yan yana getirmek istiyorum.
Yardımcı olursanız çok sevinirim.

 

[gelibolu]

Chat gpt den sordum (yaklaşık 6 kere ) şöyle bir kod verdi umarım işinize yarar.
a1b1, c1d1, e1g1 de 3 tarih olarak sorum kodda siz gereken sayı kadar değişiklik yaparsınız.

Sub FillDatesSortedDescending()
Dim startDate As Date
Dim endDate As Date
Dim currentCell As Range
Dim startCells As Variant
Dim endCells As Variant
Dim i As Integer
Dim datesArray() As Date
Dim k As Integer

' Başlangıç ve bitiş tarihlerini hücrelerden al
startCells = Array("A1", "C1", "E1")
endCells = Array("B1", "D1", "F1")

' İlk tarih aralığını H1 hücresinden başlat
Set currentCell = Range("H1")

' Tarih aralıklarını topla
For i = LBound(startCells) To UBound(startCells)
If Not IsEmpty(Range(startCells(i))) And Not IsEmpty(Range(endCells(i))) Then
startDate = Range(startCells(i)).Value
endDate = Range(endCells(i)).Value

' Her bir tarih aralığını diziye ekle
Do While startDate <= endDate
ReDim Preserve datesArray(k)
datesArray(k) = startDate
k = k + 1
startDate = startDate + 1
Loop
End If
Next i

' Diziyi en küçük tarihten başlayarak sıralayın
If k > 0 Then
Call BubbleSort(datesArray)
End If

' Diziyi en küçük tarihten başlayarak aşağıdan yukarıya doğru yazdır
For i = LBound(datesArray) To UBound(datesArray)
currentCell.Value = datesArray(i)
Set currentCell = currentCell.Offset(0, 1)
Next i
End Sub

Sub BubbleSort(arr() As Date)
Dim i As Integer, j As Integer
Dim temp As Date
For i = LBound(arr) To UBound(arr) - 1
For j = i + 1 To UBound(arr)
If arr(i) > arr(j) Then
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
End Sub

 

[Muzaffer Ali]

Merhaba.

Alternatif kod.

Sub test()
    Dim Bak As Long
    Dim Say As Integer
    Dim IzinBaslangic As Date
    Dim IzinBitis As Date
    Dim GunSay As Integer
    Say = 9
    For Bak = 2 To Cells(4, Columns.Count).End(xlToLeft).Column Step 2
        IzinBaslangic = Cells(5, Bak)
        IzinBitis = Cells(5, Bak + 1)
        GunSay = IzinBitis - IzinBaslangic
        Cells(5, Say) = IzinBaslangic
        Range(Cells(5, Say + 1).Address & ":" & Cells(5, GunSay + Say).Address).Formula = "=" & Cells(5, Say).Address(0, 0) & "+" & 1
        With Range(Cells(5, Say).Address & ":" & Cells(5, GunSay + Say).Address)
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Orientation = 90
        End With
        Say = Cells(5, Columns.Count).End(xlToLeft).Column + 1
    Next
    MsgBox "Tamamlandı."
End Sub