Gruppe
Allgemein
Problem
Aus den Betriebseintrittsdaten in Spalte E sollen die 25- und 40jährigen Jubiläen mit einer Karenzzeit von 5 Tagen ausgelesen werden.
StandardModule: basMain
Sub Jubis()
Dim wks As Worksheet
Dim iRow As Integer, iRowT As Integer
Dim i40 As Integer, i25 As Integer
Application.ScreenUpdating = False
Set wks = ActiveSheet
iRow = 1
i40 = DateSerial(Year(Date) - 40, Month(Date), Day(Date))
i25 = DateSerial(Year(Date) - 25, Month(Date), Day(Date))
Worksheets.Add after:=Worksheets(Worksheets.Count)
With wks
Do Until IsEmpty(.Cells(iRow, 1))
If CDate(i40) - .Cells(iRow, 5) < 5 And _
i40 - .Cells(iRow, 5) > -5 Then
iRowT = iRowT + 1
Rows(iRowT).Value = .Rows(iRow).Value
Cells(iRowT, 7) = 40
End If
If i25 - .Cells(iRow, 5) < 5 And _
i25 - .Cells(iRow, 5) > -5 Then
iRowT = iRowT + 1
Rows(iRowT).Value = .Rows(iRow).Value
Cells(iRowT, 7) = 25
End If
iRow = iRow + 1
Loop
End With
Columns.AutoFit
Application.ScreenUpdating = True
End Sub