Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Aus Betriebseintrittsdaten Jubiläen ermitteln

Gruppe

Berechnen

Problem

Aus den Betriebseintrittsdaten in Spalte E sollen die 25- und 40jährigen Jubiläen mit einer Karenzzeit von 5 Tagen ausgelesen werden.

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

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