Gruppen
- Top Gruppen
- Betriebsysteme
- Windows classik
- Linux
- BS-Sonstige
- Software
- Datenbanken
- Bildbearbeitung
- Audio/mp3/Video
- Security/Viren
- SW-Sonstige
- Hardware
- Mainboard/CPU
- Grafikkarten
- Peripherie
- Laptop/Notebook
- HW-Sonstiges
- Netzwerk
- Telefon,ISDN,Modem
- W-Lan
- NW-Sonstiges
- Programmierung
- PHP,ASP,Perl...
- Java,C++...
- Webseiten/HTML
- Sonstiges
- PC-Sonstiges
- Plauderecke
- SN Intern
- Test
/ Forum / Tabellenkalkulation
Tabellenkalkulation
Fragevon Donjuandan vom 24.11.2020, 16:34 Options
Frage zu einem VBA-Code
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:
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
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:
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
Antwort 1 von Hajo_Zi vom 24.11.2020, 16:44 Options
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
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 vom 24.11.2020, 17:16 Options
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
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 vom 24.11.2020, 17:42 Options
Hallo Don,
ändere die beiden Zeilen in
Found.Interior.ColorIndex = 3
Gruß Hajo
ändere die beiden Zeilen in
Found.Interior.ColorIndex = 3
Gruß Hajo
Antwort 4 von fedjo vom 24.11.2020, 17:49 Options
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
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 vom 25.11.2020, 16:25 Options
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
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
Ähnliche Themen
Laufzeitfehler im VBA Code
Meikel 26.06.2007 - 77 Hits - 1 Antwort
inputbox VBA code ändern
aeberhard 24.11.2007 - 134 Hits - 2 Antworten
VBA-Code für bestimmten Zellbereich
fantalight 03.01.2008 - 59 Hits - 17 Antworten
VBA-Code funktioniert nicht mehr
jojo5 03.07.2008 - 73 Hits - 3 Antworten
Brauche hilfe bei VBA Code
BenjaminM 30.07.2008 - 25 Hits - 20 Antworten
Hinweis
Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..
Neue Einträge
