Option
Explicit
Private
Sub
cmd_suchen_Click()
Dim
varsearch
As
Variant
Dim
rngFund
As
Range
Dim
aBereich
As
Range
Dim
rngUnion
As
Range
Dim
firstAddress
As
String
Dim
result
As
String
Dim
dtDatum
As
Date
With
Tabelle1
If
.Range(
"A2"
).Value & .Range(
"B2"
).Value =
""
Then
MsgBox (
"Bitte Datum oder Zimmernummer eintragen"
)
Exit
Sub
ElseIf
Not
IsEmpty(.Range(
"A2"
).Value)
And
Not
IsEmpty(.Range(
"B2"
).Value)
Then
MsgBox (
"Bitte nur Datum oder Zimmernummer eintragen"
)
Exit
Sub
ElseIf
.Range(
"A2"
).Value =
""
Then
Set
varsearch = .Range(
"B2"
)
With
.Range(varsearch.Offset(2), .Cells(.Rows.Count, varsearch.Column).
End
(xlUp))
Set
rngFund = .Find(What:=varsearch.Value, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If
Not
rngFund
Is
Nothing
Then
firstAddress = rngFund.Address
Do
If
rngUnion
Is
Nothing
Then
Set
rngUnion = rngFund
Else
Set
rngUnion = Union(rngUnion, rngFund)
End
If
Set
rngFund = .FindNext(rngFund)
Loop
While
Not
rngFund
Is
Nothing
And
firstAddress <> rngFund.Address
End
If
End
With
ElseIf
.Range(
"B2"
).Value =
""
Then
Set
varsearch = .Range(
"A2"
)
With
.Range(varsearch.Offset(2), .Cells(.Rows.Count, varsearch.Column).
End
(xlUp))
Set
rngFund = .Find(What:=
CDate
(varsearch.Value), _
LookIn:=xlFormulas, _
LookAt:=xlWhole)
If
Not
rngFund
Is
Nothing
Then
firstAddress = rngFund.Address
Do
If
rngUnion
Is
Nothing
Then
Set
rngUnion = rngFund
Else
Set
rngUnion = Union(rngUnion, rngFund)
End
If
Set
rngFund = .FindNext(rngFund)
Loop
While
Not
rngFund
Is
Nothing
And
firstAddress <> rngFund.Address
End
If
End
With
End
If
For
Each
aBereich
In
rngUnion.Areas
For
Each
rngFund
In
aBereich
If
rngFund.Column = 1
Then
result = result & vbCrLf & rngFund.Value &
" - Zi: "
& rngFund.Offset(, 1).Value
Else
result = result & vbCrLf & rngFund.Offset(, -1).Value &
" - Zi: "
& rngFund.Value
End
If
Next
Next
MsgBox result
End
With
End
Sub