Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Suche über mehrere Tabellenblätter
Katy
Hallo an alle Excel-Profis,
ich habe folgendes Problem und hoffe Ihr könnt mir da vielleicht helfen:
Gegeben ist eine Excel Datei mit mehreren Tabellenblättern, die als Datenbank fungiert.
Die Tabellenblätter haben jeweils einen Kopf von mehreren Zeilen, darunter (beginnt in jedem Blatt ab der gleichen Zeile) stehen Texte.
Spalten C und D, und Spalte E und F sind zusammengefasst und in Ihnen steht fortlaufender Text.
Ziel ist nun ein Wort über alle Tabellenblätter hinweg zu suchen und die betroffenen Zeilen in ein neues Tabellenblatt zu kopieren.
Ich habe mit Hilfe eines anderen Foreneintrags schon folgendes, dass soweit funktioniert:
Sub suche()
Dim c               As Range
Dim Suchwert        As Variant
Dim ws              As Worksheet
Dim ersterFundort   As String
Dim i               As Integer, z As Long
z = 1
Do
Suchwert = InputBox("Suchbegriff", "Suchbegriff")
Loop While Suchwert = ""
For Each ws In Sheets
If ws.Name = "Suchergebnis" Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next
Sheets.Add After:=Sheets(Sheets.Count)
Set ws = ActiveSheet
ws.Name = "Suchergebnis"
ws.Cells(1, 1).Value = "Suchergebnis"
ws.Cells(1, 2).Value = "im Tab.blatt"
ws.Cells(1, 3).Value = "Zelladresse"
For i = 1 To Sheets.Count - 1
Set c = Sheets(i).Cells.Find(what:=Suchwert, lookat:=xlValue)
If Not c Is Nothing Then
Do Until c Is Nothing Or c.Address = ersterFundort
If ersterFundort = "" Then ersterFundort = c.Address
z = z + 1
With ws
.Cells(z, 3).Value = c.Address(False, False)
.Cells(z, 2).Value = Sheets(i).Name
.Hyperlinks.Add Anchor:=.Cells(z, 1), Address:="", _
SubAddress:=Sheets(i).Name & "!" & c.Address(False, False), _
TextToDisplay:=CStr(c)
End With
Set c = Sheets(i).Cells.FindNext(c)
Loop
End If
Set c = Nothing
ersterFundort = ""
Next
End Sub

Problem ist jetz das Format des Suchergebnisses. Es soll ja die gesamte betroffene Zeile von C bis F herauskopiert werden soll. Wünschenswert wäre die Quellenangabe die dieser VBA Text jetzt macht (Tabellenblatt und Zelladresse) beizubehalten.
Ich hoffe sehr, dass mir hier jemand helfen kann, da ich mich leider überhaupt nicht mit VBA auskenne.
Dankeschön schon mal!

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Suche über mehrere Tabellenblätter
14.04.2011 16:04:44
fcs
Hallo Katy,
nachfolgend die Prozedur mit Ergänzung des Kopierens der Spalten C bis F.
Ich hab's unter Excel 2007 getestet. Ich bin nicht sicher, ob die verbundenen Zellen beim Kopieren in älteren Excelversionen Kummer bereiten. Falls ja, dann muss man die Werte aus den Zellen C und E der Zeile einelnen in das Blatt Suchergebnis übertragen.
Gruß
Franz
Sub suche()
Dim c               As Range
Dim Suchwert        As Variant
Dim ws              As Worksheet
Dim ersterFundort   As String
Dim i               As Integer, z As Long
z = 1
Do
Suchwert = InputBox("Suchbegriff", "Suchbegriff")
Loop While Suchwert = ""
For Each ws In Sheets
If ws.Name = "Suchergebnis" Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next
Sheets.Add After:=Sheets(Sheets.Count)
Set ws = ActiveSheet
ws.Name = "Suchergebnis"
ws.Cells(1, 1).Value = "Suchergebnis"
ws.Cells(1, 2).Value = "im Tab.blatt"
ws.Cells(1, 3).Value = "Zelladresse"
ws.Cells(1, 4).Value = "Spalte C"
ws.Cells(1, 6).Value = "Spalte E"
For i = 1 To Sheets.Count - 1
Set c = Sheets(i).Cells.Find(what:=Suchwert, lookat:=xlValue)
If Not c Is Nothing Then
Do Until c Is Nothing Or c.Address = ersterFundort
If ersterFundort = "" Then ersterFundort = c.Address
z = z + 1
With ws
.Cells(z, 3).Value = c.Address(False, False)
.Cells(z, 2).Value = Sheets(i).Name
.Hyperlinks.Add Anchor:=.Cells(z, 1), Address:="", _
SubAddress:=Sheets(i).Name & "!" & c.Address(False, False), _
TextToDisplay:=CStr(c)
'Spalten C bis D der gefundenen Zeile kopieren
With Sheets(i)
.Range(.Cells(c.Row, 3), .Cells(c.Row, 6)).Copy _
Destination:=ws.Cells(z, 4)
End With
End With
Set c = Sheets(i).Cells.FindNext(c)
Loop
End If
Set c = Nothing
ersterFundort = ""
Next
End Sub

Anzeige
AW: Suche über mehrere Tabellenblätter
18.04.2011 08:32:20
Katy
Hallo Franz,
hab es gerade ausprobiert: Es funktioniert 1A!! Vielen, vielen Danke dafür!

204 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige