Suchfunktion geht nicht

Hallo Leute,
habe mal wieder ein Problem
In ersten Schritt versuche ich über die Suchfunktion die Einträge aus der Excel-Tabelle Blattnahme 01 in die ListBox1 zu übernehmen. Der Suchbegriff Bezieht sich auf den Bereich H6:H5000 und kann folgend aussehen 01/ oder 01/123. Es währe schön wenn die Einträge in der ListBox1 auch noch aufsteigend sortiert würden.
Im zweiten Schritt sollte die Markierte Zeile der ListBox1, die Werte in TextBox2, 3, 4 und 5 anzeigen, doch so weit bin ich noch lange nicht.


Private Sub CommandButton1_Click()
Dim xSuche, xAdresse, xErste As String
Dim y As Boolean
Dim arr() As Variant
Dim c As Range
Dim iRowU As Integer
ListBox1.Clear
xSuche = TextBox1.Value
If xSuche = "" Then
MsgBox "Bitte erst einen Suchbegriff eingeben!",
Exit Sub
End If
Set c = ActiveWorksheet.Cells.Find _
(xSuche, LookIn:=xlValues)
If Not c Is Nothing Then
With Worksheets("01")
xErste = c.Address
y = True
Do Until xAdresse = xErste
ReDim Preserve arr(0 To 3, 0 To iRowU)
arr(0, iRowU) = .Cells(c.Row, 7)
arr(1, iRowU) = .Cells(c.Row, 2)
arr(2, iRowU) = .Cells(c.Row, 3)
arr(3, iRowU) = .Cells(c.Row, 4)
iRowU = iRowU + 1
Set c = .Cells.FindNext(after:=c)
xAdresse = c.Adresse(False, False)
Loop
xAdresse = ""
xErste = ""
End With
End If
If y = False Then
MsgBox "Der Suchbegriff wurde nicht gefunden!
Else
ListBox1.Column = arr
End If
End Sub

Bitte um ein Tipp was ich bei der Suchfunktion falsch mache.
bei Set c = ActiveWorksheet.Cells.Find _
(xSuche, LookIn:=xlValues)
Kommt die Fehlermeldung Objekt erforderlich ?
Vielen Dank im Voraus.
Jonny

Hallo Jonny,
noch eine Version, bei der eine Zeile nur einmal auftaucht,
auch wenn der Begriff mehrfach in der Zeile steht.
Die Parameter beim Find habe ich auch noch etwas ergänzt:


Option Explicit
Private Sub CommandButton1_Click()
Dim xSuche As String, xAdresse As String, xErste As String
Dim y As Boolean
Dim arr() As Variant
Dim rngC As Range
Dim iRowU As Integer
xSuche = TextBox1.Value
If xSuche = "" Then
MsgBox "Bitte erst einen Suchbegriff eingeben!" ',
Exit Sub
End If
With Worksheets("01")
Set rngC = .Cells(.UsedRange.Row + .UsedRange.Rows.Count, 1)
Set rngC = .Cells.Find(xSuche, after:=rngC, LookIn:=xlValues, _
LookAt:=xlPart, SearchDirection:=xlNext, MatchCase:=False)
If Not rngC Is Nothing Then
xErste = rngC.Address(False, False)
y = True
Do Until xAdresse = xErste
ReDim Preserve arr(0 To 3, 0 To iRowU)
arr(0, iRowU) = .Cells(rngC.Row, 7)
arr(1, iRowU) = .Cells(rngC.Row, 2)
arr(2, iRowU) = .Cells(rngC.Row, 3)
arr(3, iRowU) = .Cells(rngC.Row, 4)
iRowU = iRowU + 1
Set rngC = .Cells.FindNext(after:=Cells(rngC.Row, 256))
xAdresse = rngC.Address(False, False)
Loop
End If
End With
If y Then
ListBox1.Column = arr
Else
ListBox1.Clear
MsgBox "Der Suchbegriff wurde nicht gefunden!"
End If
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Forumthread: Suchfunktion geht nicht

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Suchfunktion in Excel richtig nutzen

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)