Suchen

Forumthread: Suchen

Suchen

12.08.2007 18:41:00

Gregor

Hallo
Ich suche in Spalte 3 nach allen Zeilen eines Begriffs, bei dessen Zeile ich dann einen Eintrag vornehmen will. Das habe ich bis jetzt *gebastelt". Die Suche geht aber nicht weiter, das heisst es findet immer die gleiche Zeile. Was stimmt nicht?
Die Variablen habe ich deklariert.


Sub Suche_Begriff_starten()
Application.ScreenUpdating = False
Application.EnableEvents = False
'---Fehlerprüfung bei falscher Schreibweise
On Error GoTo out
If Begriff = "" Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
Worksheets(1).Select
intLastRow = Cells(Rows.Count, Spalte).End(xlUp).Row
Set Bereich = Range(Cells(1, Spalte), Cells(intLastRow, Spalte))
For Each z In Bereich
Set SuBe = Bereich.Find(Begriff, LookAt:=xlWhole)
If Not SuBe Is Nothing Then
SuBe.Select
Zeile = SuBe.Row
Application.GoTo SuBe, True
Workbooks("Muster").Worksheets(1).Cells(Zeile, 1).Value = Workbooks("Quelle"). _
Worksheets(1).Cells(1, 1)
Else
MsgBox Prompt:="Der Begriff " & Begriff & " nicht gefunden." _
& vbNewLine & vbNewLine _
& "Bitte Schreibweise überprüfen und Suche wiederholen", _
Title:="  Hinweis für " & Application.UserName
Worksheets(1).Activate
usrBegriffSuchen.Show
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
End If
Next
Set SuBe = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
Exit Sub
out:
MsgBox Prompt:="Fehler Nummer " & Err.Number & " ist aufgetreten" _
& vbNewLine & "(" & Err.Description & ")" _
& vbNewLine & vbNewLine & "Die Ausführung wird beendet" _
& vbNewLine & "Wenden Sie sich an den Ersteller Gregor Wüest", _
Title:="  Fehlermeldung"
Worksheets(1).Activate
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Vielen Dank
Gregor

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Suchen

12.08.2007 23:17:00

Gerd
AW: Suchen

13.08.2007 13:48:16

Gregor

AW: Suchen

12.08.2007 23:17:00

Gerd

Hallo Gregor,
die Struktur für Wiederholungssuche.


Sub Suche_Begriff_starten()
Dim Begriff As String, Bereich As Range, SuBe As Range, strFirstAddress As String, lngLastRow  _
As Long
Begriff = InputBox("irgendwas")
With ThisWorkbook.Worksheets(1)
lngLastRow = .Cells(Rows.Count, 3).End(xlUp).Row
Set Bereich = .Range(.Cells(1, 3), .Cells(lngLastRow, 3))
On Error Resume Next
Set SuBe = Bereich.Find(Begriff, LookIn:=xlValues, LookAt:=xlWhole)
On Error GoTo 0
If Not SuBe Is Nothing Then
strFirstAddress = SuBe.Address
Do
MsgBox "Gefunden, mach was!", vbOKOnly
'hier Code für "gefunden"
Set SuBe = Bereich.FindNext(SuBe)
Loop While Not SuBe.Address = strFirstAddress
Else
MsgBox "Nix gefunden!", vbOKOnly
'hier Code für "nix"
End If
End With
End Sub

Gruß Gerd

AW: Suchen

13.08.2007 13:48:16

Gregor

Hallo Gerd
Vielen herzlichen Dank, bin mit deinem Vorschlag zurechtgekommen.
Gregor

Beliebteste Forumthreads (12 Monate)

Forumthread: Suchen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread