Suchroutine flexibel gestalten
20.07.2003 10:53:29
Lothar Ehret
ich habe wieder mal ein (für Euch Excel-Spezialisten hoffentlich kleines) Problem, ähnlich dem von Thomas M. (www.herber.de/forum/messages/283107.html).
Mit nachfolgendem Code suche ich im Bereich J6:L20618 den Wert einer in diesem Bereich selektierten Zelle. Jede Fundstelle wird hochgezählt und in einer MsgBox angezeigt.
Diese MsgBox möchte ich durch eine Userform ersetzen, in welcher sämtliche Daten der entsprechenden Zeile (Fundstelle) in Labels angezeigt werden. Beim Aufrufen einer Userform aus der For-Next-Schleife wird jedoch die Suchroutine abgebrochen. Will ich die Suche über einen Command-Button in der Userform fortsetzen und die nächste Fundstelle anzeigen lassen, müßte ich den Suchbereich in Abhängigkeit der aktuellen Fundstelle flexibel gestalten.
Hat jemand eine Idee, wie ich das anstelle?
Vielen Dank im voraus für jede Hilfe.
Gruß
Lothar
Sub Wert_suchen()
Dim c As New Collection
Dim r As Range
Dim r1 As Range
Dim r2 As Range
Dim ur1 As Range
Dim sh As Worksheet
Dim j As Integer
Dim k As Integer
Set sh = ActiveSheet
Set r2 = Range("J6")
If Intersect(Range("J6:L20618"), ActiveCell) Is Nothing Then
MsgBox "Bitte einen gültigen Wert anklicken!"
End If
Set rngalt = ActiveCell
suchwert = ActiveCell.Value
Set ur1 = sh.Range("J6:L20618")
Set r = ur1.Find(suchwert, lookat:=xlWhole, MatchCase:=True, after:=r2)
Set r1 = r
Do While Not r Is Nothing
c.Add sh.Name
c.Add r
Set r = ur1.FindNext(r)
If r.Address = r1.Address Then Set r = Nothing
Loop
If IsError(c.Count) Then Exit Sub
j = 1
k = c.Count
For i = 1 To c.Count Step 2
Set sh = Worksheets(c.Item(i))
sh.Activate
c.Item(i + 1).Select
Cancel = True
Mldg = MsgBox("Fundstelle " & j & " von " & (k / 2) & " - Weiter suchen?", vbYesNoCancel)
If Mldg = vbCancel Then GoTo a
If Mldg = vbYes Then GoTo b
If Mldg = vbNo Then GoTo c
a: rngalt.Select
Exit Sub
b: j = j + 1
Next
rngalt.Select
c:
End Sub