Registriert seit: 12.12.2016
Version(en): 2010
Hallo,
ich habe folgenden Code bei mir um eine Suchfunktion über ein Button zu starten, leider zeigt er mir nur die Zeilen an wo die betreffenden Suchwörter stehen,
ich möchte aber gerne das der Cursor in die Zeilen springt.
Bitte um Hilfe
DANKE
Sub Suchfunktion()
Dim bFound As Boolean
Dim rC As Range
Dim tAddr As String
Dim tSearch As String
tSearch = InputBox("Suche nach:", "Suchen")
If tSearch = "" Then Exit Sub
With ActiveSheet.Cells
Set rC = .Find(tSearch, LookIn:=xlValues)
If Not rC Is Nothing Then
tAddr = rC.Address
Do
MsgBox "Gefunden in " & rC.Address(0, 0) & ", Wert: " & rC.Value
bFound = True
Set rC = .FindNext(rC)
Loop While Not rC Is Nothing And rC.Address <> tAddr
End If
End With
If Not bFound Then MsgBox "Begriff [" & tSearch & "] nicht gefunden!"
End Sub
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Andy,
Sub Suchfunktion()
Dim bFound As Boolean
Dim rC As Range
Dim tAddr As String
Dim tSearch As String
tSearch = InputBox("Suche nach:", "Suchen")
If tSearch = "" Then Exit Sub
With ActiveSheet.Cells
Set rC = .Find(tSearch, LookIn:=xlValues)
If Not rC Is Nothing Then
tAddr = rC.Address
Do
rC.Select
MsgBox "Gefunden in " & rC.Address(0, 0) & ", Wert: " & rC.Value
bFound = True
Set rC = .FindNext(rC)
Loop While Not rC Is Nothing And rC.Address <> tAddr
End If
End With
If Not bFound Then MsgBox "Begriff [" & tSearch & "] nicht gefunden!"
End Sub
Gruß Uwe
Registriert seit: 12.12.2016
Version(en): 2010
Hallo Uwe,
Vielen DANK !
Gibt es noch die Möglichkeit die angezeigten Ergebnisse farbig zu hinterlegen ?
Vielen Dank
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
Hallo Andy,
(12.12.2016, 12:27)AndyExcel77 schrieb: Gibt es noch die Möglichkeit die angezeigten Ergebnisse farbig zu hinterlegen ?
Sub Suchfunktion()
Dim bFound As Boolean
Dim rC As Range
Dim tAddr As String
Dim tSearch As String
tSearch = InputBox("Suche nach:", "Suchen")
If tSearch = "" Then Exit Sub
With ActiveSheet.Cells
Set rC = .Find(tSearch, LookIn:=xlValues)
If Not rC Is Nothing Then
tAddr = rC.Address
Do
rC.Select
rC.Interior.ColorIndex = 4
MsgBox "Gefunden in " & rC.Address(0, 0) & ", Wert: " & rC.Value
rC.Interior.ColorIndex = 0
bFound = True
Set rC = .FindNext(rC)
Loop While Not rC Is Nothing And rC.Address <> tAddr
End If
End With
If Not bFound Then MsgBox "Begriff [" & tSearch & "] nicht gefunden!"
End Sub
Gruß Uwe
Registriert seit: 12.12.2016
Version(en): 2010
(12.12.2016, 13:44)Kuwer schrieb: Hallo Andy,
Sub Suchfunktion()
Dim bFound As Boolean
Dim rC As Range
Dim tAddr As String
Dim tSearch As String
tSearch = InputBox("Suche nach:", "Suchen")
If tSearch = "" Then Exit Sub
With ActiveSheet.Cells
Set rC = .Find(tSearch, LookIn:=xlValues)
If Not rC Is Nothing Then
tAddr = rC.Address
Do
rC.Select
rC.Interior.ColorIndex = 4
MsgBox "Gefunden in " & rC.Address(0, 0) & ", Wert: " & rC.Value
rC.Interior.ColorIndex = 0
bFound = True
Set rC = .FindNext(rC)
Loop While Not rC Is Nothing And rC.Address <> tAddr
End If
End With
If Not bFound Then MsgBox "Begriff [" & tSearch & "] nicht gefunden!"
End Sub
Gruß Uwe
Hallo,
Danke, leider zeigt er mir einen Fehler an und zwar in folgender Zeile
rC.Interior.ColorIndex = 4DANKE
Registriert seit: 12.12.2016
Version(en): 2010
12.12.2016, 14:30
(Dieser Beitrag wurde zuletzt bearbeitet: 12.12.2016, 14:30 von AndyExcel77.)
(12.12.2016, 13:44) pid=\60865' schrieb:
Registriert seit: 12.12.2016
Version(en): 2010
(12.12.2016, 13:44)Kuwer schrieb: Hallo Andy,
Sub Suchfunktion()
Dim bFound As Boolean
Dim rC As Range
Dim tAddr As String
Dim tSearch As String
tSearch = InputBox("Suche nach:", "Suchen")
If tSearch = "" Then Exit Sub
With ActiveSheet.Cells
Set rC = .Find(tSearch, LookIn:=xlValues)
If Not rC Is Nothing Then
tAddr = rC.Address
Do
rC.Select
rC.Interior.ColorIndex = 4
MsgBox "Gefunden in " & rC.Address(0, 0) & ", Wert: " & rC.Value
rC.Interior.ColorIndex = 0
bFound = True
Set rC = .FindNext(rC)
Loop While Not rC Is Nothing And rC.Address <> tAddr
End If
End With
If Not bFound Then MsgBox "Begriff [" & tSearch & "] nicht gefunden!"
End Sub
Gruß Uwe
DANKE hat doch Funktioniert
-CLOSED-