Office: (Office 2013) Geburtstage der nächsten 7 Tage aus mitarbeiterliste per MsgBox anzeigen

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 *Smilie danke schonmal

:)

 

Moin!
Schaue Dir mal die Datei an.
2.000 Namen, Geburtstage werden einerseits mittels Formeln angezeigt:

	L	M	N
1	Heute	12. Juni
2	Geburtsdatum	Name	Vorname
3	12.06.1964	Name 1063	Vorname 1063
4	12.06.1996	Name 0188	Vorname 0188

Zelle	Formel
M1	=TEXT(HEUTE();"TT. MMMM")
L3	{=WENNFEHLER(INDEX($A:$A;KKLEINSTE(WENN($B:$B00=M;ZEILE(:00));ZEILE($A1)));"")}
M3	{=WENNFEHLER(INDEX($C:$C;KKLEINSTE(WENN($B:$B00=M;ZEILE(:00));ZEILE($A1)));"")}
N3	{=WENNFEHLER(INDEX($D:$D;KKLEINSTE(WENN($B:$B00=M;ZEILE(:00));ZEILE($A1)));"")}
L4	{=WENNFEHLER(INDEX($A:$A;KKLEINSTE(WENN($B:$B00=M;ZEILE(:00));ZEILE($A2)));"")}
M4	{=WENNFEHLER(INDEX($C:$C;KKLEINSTE(WENN($B:$B00=M;ZEILE(:00));ZEILE($A2)));"")}
N4	{=WENNFEHLER(INDEX($D:$D;KKLEINSTE(WENN($B:$B00=M;ZEILE(:00));ZEILE($A2)));"")}

Achtung, Matrixformel enthalten!

Die geschweiften Klammern{} werden nicht eingegeben.

Verlassen Sie den Zelleneditor mit Strg+Shift + Enter, statt Enter alleine.

oder nach Start des Makros RPP mit Deiner gewünschten MsgBox:




Das Ganze innerhalb eines Wimperschlags. *wink.gif*
Wer die Datei wegen des Makros nicht herunterladen möchte:
hier der Code:
Modul Modul1

Gruß Ralf

 

Hi,

die Abfrage lässt sich ganz einfach beschleunigen:

1. den zu durchsuchenden Bereich korrekt einschränken und nicht eine knappe halbe Million Zeilen durchsuchen.

2. die Zugriffe auf die einzelnen Zellen auf ein Minimum beschränken.

Zu 1:

Der blaue Teil sucht in Spalte 10 (=J) von unten nach dem letzten Eintrag. Laut deiner Beschreibung müsste das die Zeile 403 sein. Und dies wird nun durch das &-Zeichen an den roten Ausdruck angehängt. Damit durchsuchst du nun den Bereich "Speicherort!H3:H403403". Das solltest du als erstes korrigieren. Und schon läuft dein Programm um den Faktor 1000 schneller!

Zu 2:

Jeder Zugriff eine Zelle kostet Zeit. Bei der Zelle rng handelt es sich schon um ein Datum. Ein Datum ist im Grund nichts anderes eine Zahl. Wenn du wissen willst, welches Datum vor 2 Tagen wahr, dann reicht es von heute die Zahl 2 abzuziehen. Man braucht nicht über DateAdd zu gehen. Und das Ganze macht man dann auch nur ein Mal und nicht sieben mal:
Code:

 

Wenn ich deinen Code eingebe kriege ich den Wert 00:00:00 als Datum ausgespuckt (Einzelschritt, da beim burchlaufen nichts kommt). der Schlickt das Dim anscheinend nicht richtig.

Zu dem hier:

For Each rng In .Range("Speicherort!H3:H403" & Application.max(2, .Cells(.Rows.Count, 10).End(xlUp).Row))

habe es nun auf :
For Each rng In .Range("Speicherort!H3:H403)

abgeändert, Super danke 1million mal schneller

 

Hi,

es ist ziemlich genau der Faktor 1.000 und nicht 1.000.000. *Smilie

Und mein "Code" ist kein kompletter Code, sondern nur Ersatz für deine IF-Zeile, die ich zitiert habe. Ersetze diese durch meine drei Zeilen.

noch besser: benutze als Bereich anstatt H3:H403 den Bereich J3:J403 und folgende Zeile Code:

 

Dank dir Hkindler,

dein Code funktioniert nur wenn ich in den Spalten J suchen lasse.
Wenn der Suchbereich bei Spalte H bleibt, kommt meine Msgbox.
Negativ, dann zeigt er mir an wer innerhalb der nächsten 7 tage Geburtstag hat aber wird 0 Jahre alt.

RPPP63 dank dir, ich werde heute deine Antwort auch mal testen und gucken was der Sekretärin besser gefällt.

 

Wenn Du das Alter ebenfalls angezeigt haben willst, solltest Du dies mittels DateDiff() errechnen.
Ändere die Sub wie folgt:

Ergibt heute:





Gruß Ralf

 

Hi,

du musst nicht alle Zeilen durchlaufen - benutze den Autofilter und durchlaufe nur die sichtbaren Zellen:

Code:

 

Hallo,

mal ein ganz anderes Thema dazu.

Du musst dir geneugenommen von jedem, zu dessen Namen auch das Geburtsdatum, als auch andere persönliche Daten enthalten sind, bestätigen lassen, dass er damit einverstanden ist, dass jeder andere, der Zugriff auf dies Mappe hat, diese Daten sehen kann und somit alle diese Personen in der Lage sind, diese Infiormationen unkontrolliert weiterzugeben.

Andernfalls ist dies ein Verstoß gegen den Datenschutz. Sofern es beu euch einen Datenschutzbeauftragten gibt, solltest du das mit diesem besprechen.

 

Ich bleibe mal beim off topic, WS-53.
Es dürfte hier doch wohl um ein Dokument der Personalabteilung gehen, um Gratifikationen oder zumindest den Glückwunsch nicht zu vergessen.
Warum sollte dem AG das GebDat nicht bekannt sein?
Nicht, dass der ansonsten vergisst, dass die Rente ansteht … *wink.gif*
(vom altersabhängigem Urlaubsanspruch mal ganz abgesehen)

 

Hallo Ralf,

es ist aus der Beschreibung nicht erkrennbar, ob es eine Mappe ist, die in der Personalabteilung geführt wird und nur Mitarbeiter der PA darauf Zugriff haben, ober ob es sich um eine Mappe handelt, die in einer Abteilung geführt wird und in dieser jeder Mitarbeiter Zugriff auf diese Mappe hat. Es ist nun einmal so, dass auch das Geburtsdatum dem Datenschutz unterliegt.

Mit meinem Beitrag wollte ich ja nur darauf hingewiesen haben!

 

Also einen Datenschutzbeauftragten gibt es hier,
da nur 2 Personen aus der Personalabteilung Sowie die Sekretärin und der Chef zugriff auf diesen im Netzlaufwerk befindlichen Ordner haben, sollte dies kein Problem darstellen.

Die Sensiblen Daten sind in SAP hinterlegt.
Dort ist es sowieso nur dem Personal der Personalabteilung / Gehaltsabteilung möglich auf die gespeicherten Daten zu zugreifen.

Zudem ist in der Excel Datei die Spalte Geburtsdatum ausgeblendet und passwortgeschützt, ebenfalls die VBA Programmierung.

Unser IT-Experte möchte sobald die Datei so angepasst ist wie sie hier Verwendung finden soll, den VBA Code in einer .DLL Datei schreiben.
Laut seiner Aussage macht es das umgehen der Passwörter dann fast unmöglich.
Ohne könnte jeder mit etwas Kenntnis die Passwörter umgehen.

Zwecks Planung wird eine Excel Liste geführt, in welcher die Ausbildungsjahrgänge sowie Fortbildungslehrgänge geplant werden.
Da wir hier einige "Müller, Meier, Schulze" mit gleichen Vornamen haben, wird die Personenkennziffer als Unterscheidungsmerkmal eingefügt.
Aus dieser lässt sich das Geburtsdatum ermitteln.

Bisher gab es keine Beanstandungen seitens Datenschutzbeauftragten.