AW: suche in Spalte mir Rückgabe der Zeilen
22.07.2003 21:00:40
Nepumuk
Hallo Heinz,
ich habe es mal zum anklicken gemacht.
Option Explicit
Public Sub suchen()
Dim Zelle As Range, Suchbegriff As String, Adresse As String, zaehler As Long
Dim Zeilen As String, Zeile() As Long, Bereich As Range, index As Long
Suchbegriff = InputBox("Suchbegriff eingeben", "Eingabe")
If Suchbegriff <> "" Then
On Error Resume Next
Set Bereich = Application.InputBox("Bitte die zu durchsuchende Spalte anklicken.", "Eingabe", Type:=8)
If Err.Number = 0 Then
With ActiveSheet.Columns(Bereich.Column)
Set Zelle = .Find(What:=Trim(Suchbegriff), LookAt:=xlWhole, MatchCase:=True)
If Not Zelle Is Nothing Then
Adresse = Zelle.Address
Do
zaehler = zaehler + 1
ReDim Preserve Zeile(1 To zaehler)
Zeile(zaehler) = Zelle.Row
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> Adresse
End If
End With
If zaehler <> 0 Then
Call sortieren(1, UBound(Zeile), Zeile)
For index = 1 To UBound(Zeile)
Zeilen = Zeilen & CStr(Zeile(index)) & ", "
Next
Zeilen = Left(Zeilen, Len(Zeilen) - 2)
MsgBox "Der Suchbegriff " & Chr(34) & Suchbegriff & Chr(34) & " wurde in diese" & IIf(zaehler = 1, "r", "n") & " Zeile" & IIf(zaehler = 1, "", "n") & " gefunden: " & Zeilen & Space(3), 64, "Information"
Else
MsgBox "Der Suchbegriff " & Chr(34) & Suchbegriff & Chr(34) & " wurde nicht gefunden.", 64, "Information"
End If
End If
End If
End Sub
Private Sub sortieren(Untergrenze As Long, Obergrenze As Long, Zeile() As Long)
Dim index1 As Long, index2 As Long, Element As Long, Zwischenspeicher As Long
index1 = Untergrenze
index2 = Obergrenze
Zwischenspeicher = Zeile(((Untergrenze + Obergrenze) / 2) \ 1)
Do
Do While Zeile(index1) < Zwischenspeicher
index1 = index1 + 1
Loop
Do While Zwischenspeicher < Zeile(index2)
index2 = index2 - 1
Loop
If index1 <= index2 Then
Element = Zeile(index1)
Zeile(index1) = Zeile(index2)
Zeile(index2) = Element
index1 = index1 + 1
index2 = index2 - 1
End If
Loop Until index1 > index2
If Untergrenze < index2 Then Call sortieren(Untergrenze, index2, Zeile)
If index1 < Obergrenze Then Call sortieren(index1, Obergrenze, Zeile)
End Sub
Code eingefügt mit: Excel Code Jeanie
Gruß
Nepumuk