Auf verschiedenen Blättern einer Mappe befinden sich in Spalte E Namen, in Spalte F Geburtstage und in Spalte J Telefonnummern. Wie kann ich die Geburtstagskinder des heutigen Tages in einer UserForm-Listbox anzeigen lassen?
Dafür gibt es verschiedene Möglichkeiten - wobei es mit der Find-Methode Probleme gibt, da die nach dem Datum sucht, nicht aber nach einem Teil davon. Gezeigt werden zwei Möglichkeiten - die erste funktioniert ab Excel 365, die zweite generell:
Einsatz der Tabellenfunktion FILTER() ab Excel 365
Das grundlegende Vorgehen ist hier wie bei der älteren Variante (siehe unten), nur beim Sammeln der Daten wird die Tabellenblattfunktion FILTER() verwendet. Die Blätter werden also auch einzeln abgearbeitet, pro Blatt arbeitet aber diese Funktion. Wir gehen hier davon aus, dass der Datenbereich ab Zeile 3 und ab Spalte C beginnt.
Die Funktion sorgt dafür, dass nicht jede Zeile auf dem Blatt durchlaufen werden muss, sondern dass bereits eine Ergebnismenge vorhanden ist - es müssen also weniger Daten ausgewertet werden. Sie liefert einen Array, in dem die Zeilen enthalten sind, in denen sich die gefundenen Geburtstage befinden. Die einzelnen Daten sind Elemente jeder Zeile, der Geburtstag ist das vierte Element (ab Spalte C). Die Datumsangaben liegen in diesem Array als Long-Zahlen vor, deshalb sind sie hier noch formatiert.
Für den praktischen Einsatz kann es notwendig sein, die Blätter noch etwas einzugrenzen, weil sonst Fehler auftreten könnten. Hier wird mit IsArray() geprüft, ob ein Array vorliegt, fürs Grobe reicht das erst mal. Die Routine:
Sub Geburtstage1()
Dim lngLZ As LongPtr
Dim intN As Integer
Dim strEintrag As String
Dim wksBlatt As Worksheet
Dim arrS(), lngArrS As LongPtr
Dim varT
lngArrS = -1
For Each wksBlatt In ActiveWorkbook.Sheets
lngLZ = wksBlatt.Cells(wksBlatt.Rows.Count, 4).End(xlUp).Row
varT = Application.Evaluate("=FILTER(" & wksBlatt.Name & "!C3:J" & lngLZ & ",(DAY(" & wksBlatt.Name & "!F3:F" & lngLZ & ")=DAY(TODAY()))*(MONTH(" & wksBlatt.Name & "!F3:F" & lngLZ & ")=MONTH(TODAY())),0)")
If IsArray(varT) Then
For intN = 1 To UBound(varT)
lngArrS = lngArrS + 1
ReDim Preserve arrS(lngArrS)
strEintrag = Format(varT(intN, 4), "DD.MM.YYYY") & " "
strEintrag = strEintrag & Format(Year(Date) - Year(varT(intN, 4)), "00") & " "
strEintrag = strEintrag & varT(intN, 3) & ", " & varT(intN, 2)
strEintrag = strEintrag & ", Telefon: " & varT(intN, 8)
strEintrag = strEintrag & " (Blatt: " & wksBlatt.Name & ")"
arrS(lngArrS) = strEintrag
Next
End If
Next
UserForm1.ListBox1.List = arrS
UserForm1.Show
End Sub
Alte Variante, generell funktionshähig
Hier wird das Verwenden einer Schleife aufgezeigt.
Dazu wird natürlich eine Userform benötigt, hier ist es UserForm1. Auf ihr sind die ListBox1 und ein Commandbutton zum Schlie�en der Userform.
Die folgende Routine, die hier in einem Standardmodul sein muss, durchläuft alle Blätter und prüft in Spalte 6 (F) auf Datumsangaben. Wenn es sich um ein Datum handelt, wird auf �bereinstimmung mit dem heutigen Tag und dem heutigen Monat geprüft. Gibt es die, wird in diesem Beispiel einfach ein String aus den Angaben gebastelt und in einen Array aufgenommen.
Am Ende wird der Array mit UserForm1.ListBox1.List an die Listbox übergeben und die Userform aufgerufen.
Sub Geburtstage()
Dim lngEZ As LongPtr, lngLZ As LongPtr, lngZ As LongPtr, lngS As LongPtr
Dim strEintrag As String
Dim wksBlatt As Worksheet
Dim arrS(), lngArrS As LongPtr
lngS = 6
lngArrS = -1
For Each wksBlatt In ActiveWorkbook.Sheets
lngEZ = wksBlatt.UsedRange.Row
lngLZ = lngEZ + wksBlatt.UsedRange.Rows.Count
If lngLZ > lngEZ Then
With wksBlatt
For lngZ = lngEZ To lngLZ
If IsDate(.Cells(lngZ, lngS)) Then
If Day(.Cells(lngZ, lngS)) = Day(Date) And Month(.Cells(lngZ, lngS)) = Month(Date) Then
lngArrS = lngArrS + 1
ReDim Preserve arrS(lngArrS)
strEintrag = .Cells(lngZ, 6).Text & " "
strEintrag = strEintrag & Format(Year(Date) - Year(.Cells(lngZ, 6)), "00") & " "
strEintrag = strEintrag & .Cells(lngZ, 5) & ", " & .Cells(lngZ, 4)
strEintrag = strEintrag & ", Telefon: " & .Cells(lngZ, 10)
strEintrag = strEintrag & " (Blatt: " & .Name & ")"
arrS(lngArrS) = strEintrag
End If
End If
Next
End With
End If
Next
UserForm1.ListBox1.List = arrS
UserForm1.Show
End Sub
Es gibt natürlich auch Alternativen. So kann z. B. der Array mehrspaltig verwendet und das Ganze zu einer Funktion umgeschrieben werden, die den Array zurückgibt und beliebig eingesetzt werden kann. Oder die Listbox wird mit ColumnCount mehrspaltig erstellt und die einzelnen Daten werden auf mehrere Spalten verteilt. Oder die Daten werden sofort in die Listbox geschrieben. Oder, oder, oder �
Soll die Geburtstagsprüfung beim Dateiaufruf erfolgen, wird im Klassenmodul DieseArbeitsmappe (doppelt anklicken) dieser Code eingefügt:
Private Sub Workbook_Open()
Geburtstage
End Sub
Damit der Commandbutton wirkt: Doppelklick auf den Button und diesen Code eintragen:
Private Sub CommandButton1_Click()
Unload Me
End Sub
Suchergebnisse (14 Treffer, 1 Begriff) 
Kategorien: 
