DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sorgu için arama sonuçları: yıllık izin
www.excel.web.tr
merhaba değerli hocalarım ,
destek bekliyorum. Malum 2025 yılı yıllık izin planlaması başlamak üzere...
teşekkürler,
Sub IzinHesapla()
Dim wsInput As Worksheet
Dim wsOutput As Worksheet
Dim lastRow As Long, lastCol As Long
Dim izinBaslangic As Long, izinBitis As Long
Dim currentRow As Long, outputRow As Long
Dim izinGun As Long
Dim i As Long
Dim colOffset As Long
Dim baslangicTarih As String, bitisTarih As String
Set wsInput = ThisWorkbook.Sheets("yillik izin günü")
Set wsOutput = ThisWorkbook.Sheets("izin baslangic bitis")
lastRow = wsInput.Cells(wsInput.Rows.Count, 1).End(xlUp).row
lastCol = wsInput.Cells(6, wsInput.Columns.Count).End(xlToLeft).Column
wsOutput.Rows("2:" & wsOutput.Rows.Count).ClearContents
outputRow = 2
For currentRow = 8 To lastRow
izinBaslangic = 0
izinBitis = 0
izinGun = 0
colOffset = 9
wsOutput.Cells(outputRow, 1).Value = wsInput.Cells(currentRow, 1).Value
wsOutput.Cells(outputRow, 2).Value = wsInput.Cells(currentRow, 2).Value
wsOutput.Cells(outputRow, 3).Value = wsInput.Cells(currentRow, 3).Value
wsOutput.Cells(outputRow, 4).Value = wsInput.Cells(currentRow, 4).Value
wsOutput.Cells(outputRow, 5).Value = wsInput.Cells(currentRow, 5).Value
wsOutput.Cells(outputRow, 6).Value = wsInput.Cells(currentRow, 6).Value
wsOutput.Cells(outputRow, 7).Value = wsInput.Cells(currentRow, 7).Value
wsOutput.Cells(outputRow, 8).Value = wsInput.Cells(currentRow, 8).Value
For i = 8 To lastCol
If wsInput.Cells(currentRow, i).Value = "X" Then
If izinBaslangic = 0 Then
izinBaslangic = i
End If
izinBitis = i
izinGun = izinGun + 1
ElseIf izinBaslangic > 0 Then
If i - izinBitis > 7 Then
baslangicTarih = GetFullDate(wsInput, 7, 6, izinBaslangic)
bitisTarih = GetFullDate(wsInput, 7, 6, izinBitis + 1)
wsOutput.Cells(outputRow, colOffset).Value = baslangicTarih
wsOutput.Cells(outputRow, colOffset + 1).Value = bitisTarih
wsOutput.Cells(outputRow, colOffset + 2).Value = izinGun
colOffset = colOffset + 3
izinBaslangic = 0
izinBitis = 0
izinGun = 0
End If
End If
Next i
If izinBaslangic > 0 Then
baslangicTarih = GetFullDate(wsInput, 7, 6, izinBaslangic)
bitisTarih = GetFullDate(wsInput, 7, 6, izinBitis + 1)
wsOutput.Cells(outputRow, colOffset).Value = baslangicTarih
wsOutput.Cells(outputRow, colOffset + 1).Value = bitisTarih
wsOutput.Cells(outputRow, colOffset + 2).Value = izinGun
End If
outputRow = outputRow + 1
Next currentRow
MsgBox "Izin hesaplama tamamlandi", vbInformation
End Sub
Function GetFullDate(ws As Worksheet, aySatir As Long, gunSatir As Long, col As Long) As String
Dim ay As String, gun As String
ay = ws.Cells(aySatir, col).MergeArea.Cells(1, 1).Value
gun = ws.Cells(gunSatir, col).Value
GetFullDate = gun & " " & ay & " 2024"
End Function
Function GetFullDate(ws As Worksheet, aySatir As Long, gunSatir As Long, col As Long) As String
Dim ay As String, gun As String, yil As String
ay = ws.Cells(aySatir, col).MergeArea.Cells(1, 1).Value
gun = ws.Cells(gunSatir, col).Value
yil = "2025"
GetFullDate = Format(DateValue(gun & " " & ay & " " & yil), "dd.mm.yyyy")
End Function