'entwickelt von Winfried Radner
'e-mail: Wolf.W.Radzinski@gmx.de
'Benutzung frei - ohne Gewähr

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+
'+  sucht den Inhalt der aktiven Zelle in der gesamten Spalte der aktiven Zelle
'+  und fügt die rechte Nachbarzelle zur ErgebnisSelection hinzu
'+  auf diese Zellauswahl können dann später beliebige Aktionen ausgeführt werden
'+  z.B. Summe, Mittelwert, Median etc.
'+
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Sub suchen_in_spalte_msa()
On Error Resume Next
Dim c As New Collection
Dim r As Range
Dim r1 As Range
Dim sel As Range

mylookat = xlWhole
mymatchcase = True

suchwert = ActiveCell.Value
Set sel = ActiveCell.EntireColumn
Set r = sel.Find(suchwert, lookat:=mylookat, MatchCase:=mymatchcase)
Set r1 = r
Do While Not r Is Nothing
     c.Add r.Offset(0, 1)
     Set r = sel.FindNext(r)
     If r.Address = r1.Address Then Set r = Nothing
     Loop
If IsError(c.Count) Then Exit Sub
Set sel = c.Item(1)
If c.Count > 1 Then
    For i = 2 To c.Count
       Set sel = Union(sel, c.Item(i))
       Next
    End If
sel.Select

mymedian = WorksheetFunction.Median(sel)
mysum = WorksheetFunction.Sum(sel)
myaverage = WorksheetFunction.Average(sel)

MsgBox mymedian & " m" & vbNewLine & mysum & " s" & vbNewLine & myaverage & " a"

End Sub