Hallo sabrina,
es wäre geschickt gewesen, wenn du mitgeteilt hättest, wie du den Bereich für die Suche festlegen möchtest. Ich habe hier ein allgemeines Verfahren benutzt, das hierzu entweder Markierungen (auch mehrere getrennte), Bereichsangaben oder alle benutzten Zellen auswertet. Die gefundene Zelle wird markiert, oder es wird eine Meldung ausgegeben, dass keine passende Datumsangabe existiert. Anstelle der Gosub-Anweisung wäre auch eine Prozdur möglich, jedoch müssten m.E. zu viele Variablen übergeben werden.
Sub nahes_z_datum()
m = 100000
If Selection.Areas.Count > 1 Or Selection.Columns.Count > 1 Or _
Selection.Rows.Count > 1 Then
For i = 1 To Selection.Areas.Count
For Each c In Selection.Areas(i)
GoSub min_best
Next
Next i
Else
a = InputBox("Linke obere Ecke der Zellen mit den Datumswerten" + _
vbCrLf + "oder 'alle Zellen'", "Nächstes Datum", "alle Zellen")
If InStr(LCase(a), "alle zellen") = 0 Then
b = InputBox("Rechte untere Ecke der Zellen mit den Datumswerten", _
"Nächstes Datum")
Set Datumwerte = Range(a, b)
For Each c In Datumwerte
GoSub min_best
Next
Else
For Each c In ActiveSheet.UsedRange
GoSub min_best
Next
End If
End If
If mrow > 0 Then
Cells(mrow, mcol).Select
Else
MsgBox "Keine Zelle mit passender Datumsangabe gefunden!"
End If
Exit Sub
min_best:
If IsDate(c) = True Then
d = c - Now
If d > 0 And d < m Then m = d: mrow = c.Row: mcol = c.Column
End If
Return
End Sub
Gruß
Holger
|