mit einer abfrage mehrere sheets durchsuchen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jens,
folgender Code sucht in allen Tabellen der Mappe.

Public Sub suchen()
Dim Zelle As Range, Suchbegriff As String, Adresse As String, zaehler As Integer
Dim index As Integer, Feld() As String, Tabelle() As Integer, Zeile_Spalte() As String
Suchbegriff = InputBox("Suchbegriff eingeben", "Eingabe")
If Suchbegriff <> "" Then
For index = 1 To Worksheets.Count
With Sheets(index).Cells
Set Zelle = .Find(What:=Trim(Suchbegriff), LookAt:=xlPart)
If Not Zelle Is Nothing Then
Adresse = Zelle.Address
Do
zaehler = zaehler + 1
ReDim Preserve Feld(1 To zaehler)
ReDim Preserve Tabelle(1 To zaehler)
ReDim Preserve Zeile_Spalte(1 To zaehler)
Feld(zaehler) = Sheets(index).Name & " Spalte " & Zelle.Column & " Zeile " & Zelle.Row
Tabelle(zaehler) = index
Zeile_Spalte(zaehler) = Zelle.Address
Set Zelle = .FindNext(Zelle)
Loop While Not Zelle Is Nothing And Zelle.Address <> Adresse
End If
End With
Next
If zaehler > 0 Then
If MsgBox(Suchbegriff & " wurde " & CStr(zaehler) & " mal gefunden." & vbNewLine & "Fundstellen anzeigen?", 68, "Information") = 7 Then Exit Sub
Do
For index = 1 To zaehler
Sheets(Tabelle(index)).Select
Range(Zeile_Spalte(index)).Select
ActiveWindow.ScrollColumn = Selection.Column
ActiveWindow.ScrollRow = Selection.Row
If zaehler = 1 Then Exit Do
If index < zaehler Then
If MsgBox(CStr(index) & ". Fundstelle von " & CStr(zaehler) & ": " & Feld(index) & vbNewLine & "Weitere anzeigen?", 68, "Information") = 7 Then Exit Do
Else
If MsgBox(CStr(index) & ". Fundstelle von " & CStr(zaehler) & ": " & Feld(index) & vbNewLine & "Nochmal anzeigen?", 68, "Information") = 7 Then Exit Do
End If
Next
Loop
Else
MsgBox Suchbegriff & " wurde nicht gefunden", 64, "Information"
End If
End If
End Sub

Gruß
Nepumuk

Hallo, danke für die schnelle Antwort. Bevor ich es in meine form einfüge probiere ich immer als modul. So wollte ich es machen. Wie gesagt auf einem sheet geht es!

Sub versuch_vereinigung()
Dim a As Range
Dim b As Range
Dim c As Range
Dim d As Range
Dim e As Range
Dim suchbereich As Range
Set a = ActiveWorkbook.Worksheets("1000").Range("H2:H101")
Set b = ActiveWorkbook.Worksheets("1100").Range("H2:H101")
Set c = ActiveWorkbook.Worksheets("1200").Range("H2:H101")
Set d = ActiveWorkbook.Worksheets("1300").Range("H2:H101")
Set e = ActiveWorkbook.Worksheets("1400").Range("H2:H101")
Set Beispiel = textbox7.value
DAS GEHT!!>> Set suchbereich = Union(Range("H2:H101"), Range("G1:G4"), Range("F1:F4"))
DAS GEHT NICHT!>> 'Set suchbereich = Union(Range(a), Range(b), Range(c), Range(d))
Set x = suchbereich.Find("Beispiel", LookIn:=xlValues)
If x Is Nothing Then
MsgBox "Sch..."
Else
MsgBox "Gut"
End If
End Sub

Beliebteste Forumthreads (12 Monate)

mit einer abfrage mehrere sheets durchsuchen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread