Supportnet / Forum / Tabellenkalkulation

Guten Morgen, ich benötige in meiner Excel Tabelle eine Suchfunktion, mit der ich wenn ich einen Suchbegriff in ein Input Fenster eingebe den zu suchenden Wert selektiert bekomme und Excel dann automatisch an diese Stelle springt Habe das ganze auch schon probiert, klappt bei mir aber nur über ein einziges Tabellenblatt. Da ich noch VBA Anfänger bin hoffe ich nun auf eure Hilfe. Hab auch schon das Forum und Internet durchforstet, aber keine passende Lösung gefunden. Hier mal die Sachen, die ich probiert habe und die nicht funktioniert haben: Sub Suchen() Dim Suchebegriff As String, Bereich As Range, ErsteAddresse As String, _ gefunden() As String, Index1 As Integer, Index2 As Integer, Text As String Dim wsTabelle As Worksheet Text = "Die nächste Übereinstimmung anzeigen?" Do Suchebegriff = InputBox("Mindestens die 3 ersten Buchstaben des" & _ " kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen") If Suchebegriff = "" Or Len(Suchebegriff) = 0 Then Exit Sub Loop Until Len(Suchebegriff) > 2 For Each wsTabelle In ThisWorkbook.Sheets Set Bereich = Range("A1:IV65536").Find(what:=Suchebegriff, lookat:=xlPart, _ LookIn:=xlValues, MatchCase:=False) If Bereich Is Nothing Then Beep MsgBox "Suchbegriff wurde nicht gefunden74" GoTo Ende Else Application.ScreenUpdating = True ErsteAddresse = Bereich.Address ´Do ´Index1 = Index1 + 1 ´ReDim Preserve gefunden(1 To Index1) gefunden(Index1) = Bereich.Address End If Ende: Next wsTabelle ´Set Bereich = Range("A1:IV65536").FindNext(Bereich) ´If Bereich Is Nothing Then GoTo Ende ´Loop While Bereich.Address <> ErsteAddresse ´Do ´Index2 = Index2 + 1 ´If Index2 = Index1 Then ´Text = "" ´End If Range(gefunden(Index2)).Select ActiveWindow.ScrollRow = Selection.Row ActiveWindow.ScrollColumn = Selection.Column ´If MsgBox(CStr(Index2) & ". von " & CStr(Index1) & " gefundenen " & _ ´"Übereinstimmungen des Suchbegriffes." & vbNewLine & Text, schalter, _ ´"Anzeige") = 7 Then Exit Do ´If Index2 = Index1 Then Exit Do ´Loop ´End If End Sub ---------------------------------------------- ---------------------------------------------- ---------------------------------------------- ---------------------------------------------- ---------------------------------------------- ---------------------------------------------- Das hier ist der zweite Code, den ich ausprobiert habe: Dieser einfache Code macht eigentlich schon das nötigste, was ich brauche, er funktioniert aber nur in meinem gerade aktiven Tabellenblatt. Natürlich wäre so eine Auflistung, die mir aufzählt wieviele Ergebnisse gefunden wurden (so wie im Script oben) auch ganz schön. Option Explicit Private Sub Suchen7474() Dim wsTabelle As Worksheet Dim strSuchBegriff As String Dim rngSuchErgebnis As Range strSuchBegriff = InputBox("Bitte Suchbegriff eingeben:", "Alle geöffneten Exceldateien durchsuchen") If strSuchBegriff = "" Then Exit Sub For Each wsTabelle In ThisWorkbook.Sheets Set rngSuchErgebnis = wsTabelle.Cells.Find(strSuchBegriff) If Not rngSuchErgebnis Is Nothing Then If rngSuchErgebnis.Select = "" Then ´ Hier bekomme ich den Fehler Die Select Eigenschaft des Range Objekts kann nicht zugeordnet ´werden, wenn ich in einem anderen Tabellenblatt als dem aktiven, in dem ich mich gerade befinde einen Wert suche Exit Sub Else rngSuchErgebnis.Select End If End If Next End Sub Danke schon mal im Vorraus, ich hoffe ihr könnt mir weiterhelfen

Moin Boerrt,

versuchs mal hiermit:

Option Explicit

Sub suchen()
Dim strSuch As String, ws As Integer, rng As Range, strNeu As String
Start:
Do
strSuch = InputBox("Wonach wird gesucht?" & Chr(13) & "Mindestens 3 Buchstaben angeben!")
If strSuch = "" Or Len(strSuch) = 0 Then Exit Sub
Loop While Len(strSuch) < 3
ws = 1
Do While ws <= Worksheets.Count
Sheets(ws).Select
Set rng = Cells.Find(What:=strSuch, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False)
If rng Is Nothing And ws = Worksheets.Count Then
strNeu = MsgBox("Keine Begriff gefunden!" & Chr(13) & "Möchten sie erneut suchen?", vbYesNo)
If strNeu = vbNo Then
Exit Sub
Else
GoTo Start
End If
ElseIf rng Is Nothing And ws < Worksheets.Count Then
ws = ws + 1
Else
rng.Select
Exit Sub
End If
Loop
End Sub


Gruß

JöKe

Hallo JöKe,

vielen Dank für deine Hilfe. Das ist genau das wonach ich gesucht habe. Danke nochmal. Hab nämlich eine Tabelle auf der alle Teilenummern gelistet sind und jedes neue Regal ein eigenes Sheet bekommt. Nun kann man nach der Teilenummer schauen und bekommt gleich angezeigt wo sich das Material befinet.

Hatte in der Zwischenzeit auch schon ein anderes VBA Scrpt gefunden, was einigermaßen funktioniert hat (http://www.office-loesung.de/ftopic70052_75_0_asc.php) aber hier gibts ein riesiges Problem bei dem Befehl

Loop While Not rngSuchErgebnis Is Nothing And rngSuchErgebnis.Address <> strErsteAdresse 

Habe nämlich verbundene Zellen mit in der Tabelle und wenn er nach einem solchen Wert in einer verbundenen Zelle suchen soll, bekomme ich den Fahler "Objektvariable oder With Blockvariable nicht festgelegt"

Mit deinem Script gehts aber!
Danke

Okay, das Problem habe ich lösen können.

Man muss or den Loop noch

If rngSuchErgebnis Is Nothing Then Exit Do

einfügen, dann klappt alles

Gruß,Boerrt

• Excel Makro erscheint nicht in Makroliste
• Excel VBA: Berechnung ausschalten?
• Suchfunktiuon in Arbeitsmappe
• excel tabellenblätter umbenennen
• Excel Tabellenblätter zusammenführen