Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Frage zu einem VBA-Code





Frage

Hallo zusammen. Ich habe eine Frage zu einem VBA Code den ich im Internet gefunden habe. Mit dem folgendem Code kann man in einem Excel-Tabellen Blatt ein Begriff suchen. Es entsteht jedoch ein Problem, wenn ein Begriff mehrere male vorkommt: Beispiel: Ich suche nach dem Wort „Müller“. Nach dem Suchen wird die entsprechende Zelle markiert und ich werde gefragt, ob ich noch einmal suchen will. Wenn ich noch einmal nach „Müller“ suche, wird jedoch nicht der nächste „Müller“ markiert sondern wieder derselbe wie vorhin. Könnte mir jemand den Code so abändern, dass wenn ein Begriff gefunden wurde, dass man weitersuchen kann und der nächste Begriff markiert wird (so ähnlich wie bei der Standart Excel-Suchfunktion) Vielen Dank im Voraus! LG Donjuandan VBA-Code: [i]Option Explicit Dim Suchbegriff As String Dim sht As Worksheet Dim Found As Range Dim FirstAddress As String Dim Zähler As Long Dim xy As Long Sub suchen_Blatt() xy = ActiveSheet.Index Zähler = 0 Suchbegriff = InputBox("Bitte geben Sie den Suchbegriff ein:" & Chr(13) & Chr(13) _ & "Bitte unbedingt die Groß- Kleinschreibung beachten!", "Suche im Blatt", "Suchbegriff") If StrPtr(Suchbegriff) = 0 Then Exit Sub Else If Suchbegriff = "" Then Select Case MsgBox("Sie haben nichts eingegeben !", vbRetryCancel Or vbExclamation Or vbDefaultButton1, "Suchbegriff fehlt") Case vbRetry Call suchen_Blatt Case vbCancel Exit Sub End Select Else End If End If Sheets(xy).Select Set Found = Sheets(xy).Cells.Find(Suchbegriff) If Not Found Is Nothing Then FirstAddress = Found.Address Do Found.Activate Zähler = 1 Call roter_Rand Set Found = Cells.FindNext(After:=ActiveCell) If Found.Address = FirstAddress Then Exit Do Call roter_Rand Loop End If If Zähler < 1 Then GoTo Err Else Select Case MsgBox("Der gesuchte Wert ist gefunden" _ & vbCrLf & "und Rot umrandet " _ & vbCrLf & "Weitere suche ??" _ , vbYesNo Or vbInformation Or vbDefaultButton1, "Suchen in Blatt") Case vbYes Call suchen_Blatt Case vbNo Exit Sub End Select Exit Sub End If Err: Select Case MsgBox("Der gesuchte Begriff wurde nicht gefunden." _ & vbCrLf & "Wollen Sie noch einmal suchen." _ , vbRetryCancel Or vbInformation Or vbSystemModal Or vbDefaultButton1, "Suche im Blatt") Case vbRetry Call suchen_Blatt Case vbCancel Exit Sub End Select End Sub Private Function roter_Rand() Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThick .ColorIndex = 3 End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThick .ColorIndex = 3 End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThick .ColorIndex = 3 End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThick .ColorIndex = 3 End With End Function[/i]

Antwort 1 von Hajo_Zi

Hallo Don,

Sub Find_mehrmals()
'*************************************************
'* H. Ziplies *
'* 24.11.08 *
'* erstellt von Hajo.Ziplies@WEB.de *
'* http://Hajo-Excel.de *
'*************************************************
Dim Found As Range
Dim FirstAddress As String
Dim Search As String
Dim LoLetzte As Long
Dim LoI As Long
Dim ByMldg As Byte
Search = Worksheets("Tabelle2").Range("A1")
With Worksheets("Tabelle1")
LoLetzte = IIf(IsEmpty(.Range("A65536")), .Range("A65536").End(xlUp).Row, 65536)
' von Peter Haserodt
Set Found = .Range("A1:A" & LoLetzte).Find(Search, .Range("A" & LoLetzte), , xlWhole, , xlNext)
' *****
If Found Is Nothing Then Exit Sub 'falls nicht gefunden wird sub verlassen
If MsgBox("Gefunden in Zelle " & Found.Address(0, 0) & " ist dies richt richtige Zelle !!!" _
, vbYesNo + vbQuestion, "Abfrage") = 6 Then
Found.ColorIndex = 3
Else
FirstAddress = Found.Address
Do
Set Found = .Range("A1:A" & LoLetzte).FindNext(Found)
If Found.Address = FirstAddress Then Exit Sub
If MsgBox("Gefunden in Zelle " & Found.Address(0, 0) & " ist dies richt richtige Zelle !!!" _
, vbYesNo + vbQuestion, "Abfrage") = 6 Then
Found.ColorIndex = 3
Exit Do
End If
If Found.Row = LoLetzte Then Exit Do
LoI = LoI + 1
Loop
End If
End With
Set Found = Nothing
End Sub


es wird nach Inhalt von Worksheets("Tabelle2").Range("A1") gesucht

Gruß Hajo

Antwort 2 von Donjuandan

Hallo Hajo

Vielen Dank für deine schnelle Antwort! Leider funktioniert der Code nicht richtig. Ich habe das Tabellenblatt angepasst d.h. den Begriff Tabelle2 jeweils ersetzt. Sonst habe ich nichts abgeändert. Den Code habe ich in ein neues Modul eingefügt. Beim Ausführen erscheint folgende Meldung: "Gefunden in Zelle A1 ist dies richt richtige Zelle!!" (klingt komisch, stand aber genauso da)
Wenn ich anschliessend auf Ja klicke erscheint die Meldung "Laufzeitfehler 438, Objekt unterstützt diese Eigenschaft oder Methode nicht"

Wird bei diesem Code nur die Spalte A durchsucht oder das gesammte Tabellenblatt? Was habe ich falsch gemacht?

LG

Antwort 3 von Hajo_Zi

Hallo Don,

ändere die beiden Zeilen in
Found.Interior.ColorIndex = 3

Gruß Hajo

Antwort 4 von fedjo

Hallo Donjuandan,
der Code sucht in der aktiven Tabelle öfter nach dem Suchbegriff. Oder soll in allen Tabellen gesucht werden?

Gruß
fedjo

Sub Suchen()
Dim GWeiter As Boolean
Dim SSearch As String
Dim firstAddress As String
Dim secAddress
Dim c
Dim GFound As Boolean
SSearch = InputBox("Suchen nach:", SSearch)
If SSearch = "" Then
End
End If
With Cells
Set c = .Find(SSearch, LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
GFound = True
c.Select
firstAddress = c.Address
If MsgBox("Weitersuchen ?", vbQuestion + vbYesNo) = vbYes Then
Do
Set c = .FindNext(c)
secAddress = c.Address
If c.Address = firstAddress Then
Exit Do
End If
c.Select
If MsgBox("Weitersuchen ?", vbQuestion + vbYesNo) = vbNo Then
GWeiter = True
GoTo ende
End If
Loop While Not c Is Nothing And secAddress <> firstAddress And c.Address <> firstAddress
Else
GWeiter = True
GoTo ende
End If
End If
End With
ende:
If GFound = False Then
MsgBox "Suchwert nicht gefunden "
Else
If GWeiter = False Then
MsgBox "Kein Suchwert mehr vorhanden"
End If
End If
End Sub

Antwort 5 von Donjuandan

Danke für eure Antworten!

Hajo: Ich habe die Änderungen in deinem Code vorgenommen, leider erscheint immer noch dieselbe Fehlermeldung :-(

Fedjo: Dein Code funktioniert. Ist genau das, was ich gesucht habe :-D

Liebe Grüsse
donjuandan

Antwort 6 von nighty

hi fedjo :-)

hier ist was nettes :-)

ist eine xla datei und fuegt in excel ein neues menue ein um code einzuruecken :-))

gruss nighty

http://vbahtml.origo.ethz.ch/download


Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: