Guten tag, ich bin ein Anfänger mit VBA Programierung.
Zu meinem Problem, ich habe eine Personalliste in Excel, welche dem Nutzer beim Start die Geburtstage der nächsten 7 Tage anzeigt.
Das funktioniert auch, aber dauert recht lange 45-60 sec und manchmal schmiert Excel mir ab.
Vielleicht helft ihr mir auf die Sprünge wie ich dieses Problem anders lösen kann.
Da es solange dauert habe ich es derzeit über einen Command Button laufen, soll aber falls sich die abfrage beschleunigen lässt als Workbook_open laufen.
Geburtstage der Mitarbeiter stehen im Bereich H3:H403 in dem Format "TT.MM.JJJ" bsp "12.06.1961"
in Spalte J steht das Geburtstag in diesem Jahr bsp. "12.06.2018"
Spalte E = Nachname
Spalte F= Vorname
Zeile 2 sind die Überschriften meiner Tabelle und Zeile 1 ist als Platzhalter für die Commandbuttons
Am liebsten wäre es mir wenn er in Der MsgBox einzeln auflistet Tageweise wer da Geburtstag hat, dann brauche ich das nicht in der Ausgabezeile wie es bisher in meinem Code ist
Hier der Code:
Sub Birthday()
Dim rng As Range
Dim cel As Range
Dim strMsg As String
On Error Resume Next
If MsgBox("Wollen Sie alle Geburtstage der nächsten 7 Tage angezeigt bekommen? (Dauer ca 45 Sekunden)", vbYesNo) = vbNo Then Exit Sub
With Sheets("Speicherort")
For Each rng In .Range("Speicherort!H3:H403" & Application.max(2, .Cells(.Rows.Count, 10).End(xlUp).Row))
If DateSerial(Year(Date), Month(rng), Day(rng)) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -1, rng))) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -2, rng))) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -3, rng))) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -4, rng))) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -5, rng))) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -6, rng))) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -7, rng))) = Date Then
strMsg = strMsg & Left(.Cells(rng.Row, 5).Text & " " & .Cells(rng.Row, 6).Text, 35) & " wird " & Year(Date) - Year(rng) & " Jahre alt am " & Left(.Cells(rng.Row, 10).Text, 35) & vbLf
End If
Next
End With
If Len(strMsg) Then
strMsg = "Heute ist der " & Format(Date, "dddd, dd.MM.yyyy") & vbLf & vbLf & strMsg
MsgBox strMsg
End If
On Error GoTo 0
End Sub
PS: Hoffe das ist nachvollziehbar danke schonmal
Zu meinem Problem, ich habe eine Personalliste in Excel, welche dem Nutzer beim Start die Geburtstage der nächsten 7 Tage anzeigt.
Das funktioniert auch, aber dauert recht lange 45-60 sec und manchmal schmiert Excel mir ab.
Vielleicht helft ihr mir auf die Sprünge wie ich dieses Problem anders lösen kann.
Da es solange dauert habe ich es derzeit über einen Command Button laufen, soll aber falls sich die abfrage beschleunigen lässt als Workbook_open laufen.
Geburtstage der Mitarbeiter stehen im Bereich H3:H403 in dem Format "TT.MM.JJJ" bsp "12.06.1961"
in Spalte J steht das Geburtstag in diesem Jahr bsp. "12.06.2018"
Spalte E = Nachname
Spalte F= Vorname
Zeile 2 sind die Überschriften meiner Tabelle und Zeile 1 ist als Platzhalter für die Commandbuttons
Am liebsten wäre es mir wenn er in Der MsgBox einzeln auflistet Tageweise wer da Geburtstag hat, dann brauche ich das nicht in der Ausgabezeile wie es bisher in meinem Code ist
Hier der Code:
Sub Birthday()
Dim rng As Range
Dim cel As Range
Dim strMsg As String
On Error Resume Next
If MsgBox("Wollen Sie alle Geburtstage der nächsten 7 Tage angezeigt bekommen? (Dauer ca 45 Sekunden)", vbYesNo) = vbNo Then Exit Sub
With Sheets("Speicherort")
For Each rng In .Range("Speicherort!H3:H403" & Application.max(2, .Cells(.Rows.Count, 10).End(xlUp).Row))
If DateSerial(Year(Date), Month(rng), Day(rng)) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -1, rng))) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -2, rng))) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -3, rng))) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -4, rng))) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -5, rng))) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -6, rng))) = Date Or _
DateSerial(Year(Date), Month(rng), Day(DateAdd("d", -7, rng))) = Date Then
strMsg = strMsg & Left(.Cells(rng.Row, 5).Text & " " & .Cells(rng.Row, 6).Text, 35) & " wird " & Year(Date) - Year(rng) & " Jahre alt am " & Left(.Cells(rng.Row, 10).Text, 35) & vbLf
End If
Next
End With
If Len(strMsg) Then
strMsg = "Heute ist der " & Format(Date, "dddd, dd.MM.yyyy") & vbLf & vbLf & strMsg
MsgBox strMsg
End If
On Error GoTo 0
End Sub
PS: Hoffe das ist nachvollziehbar danke schonmal