Gruppe
Feature
Problem
A1 soll von 22:01-06:00, B1 von 06:01 bis 14:00 und C1 von 14:01 bis 22:00 Uhr einen Rahmen erhalten.
StandardModule: Modul1
Sub Auswahl()
Dim rng As Range, rngLast As Range
Dim lRow As Long
Dim sBegriff As String, sAddress As String
sBegriff = InputBox( _
prompt:="Bitte Suchbegriff eingeben:", _
Default:="Hallo")
If sBegriff = "" Then Exit Sub
Set rng = Cells.Find( _
what:=sBegriff, _
lookat:=xlWhole, _
LookIn:=xlValues, _
MatchCase:=False, _
after:=ActiveCell)
If rng Is Nothing Then
Beep
MsgBox "Suchbegriff nicht gefunden!", , _
Application.UserName
Exit Sub
End If
sAddress = rng.Address
rng.Select
rng.Offset(1).Select
Do
Set rngLast = ActiveCell
Cells.FindNext(after:=ActiveCell).Activate
If ActiveCell.Address = sAddress Then Exit Do
Loop
lRow = Range("A1").CurrentRegion.Rows.Count + 1
Rows(lRow).Value = rngLast.EntireRow.Value
End Sub