Makro mit Suchfunktion + Überschrift

Hallo Zusammen

ich habe auf der Suche nach einem makro, dass in meiner Tabelle ein Makro startet folgendes gefunden

Code:
Option Explicit
Public Sub Suche_Anzeige()

Dim rngBereich As Range
Dim strGefunden As String
Dim strFinden As String
Dim wksBlatt As Worksheet
Dim wksBlattNeu As Worksheet
Dim lngLetzteZeile As Long
Dim lngZeile As Long
Dim intSpalte As Integer

On Error GoTo Suche_Anzeige_Error
For Each wksBlatt In ThisWorkbook.Sheets
If wksBlatt.Name Like „Gefunden_*“ Then
Application.DisplayAlerts = False
wksBlatt.Delete
Application.DisplayAlerts = True
End If
Next wksBlatt

strFinden = InputBox(„Geben sie das gesuchte Wort oder“ & vbLf & _
„den gesuchten Wortteil ein:“, „Suchen“, „Suchbegriff“)

If strFinden = „“ Then Exit Sub

Set wksBlattNeu = Worksheets.Add(before:=Sheets(1))
wksBlattNeu.Name = „Gefunden_“ & Format(Now, „dd_mm_yy_hh_mm_ss“)

For Each wksBlatt In ThisWorkbook.Sheets
If wksBlatt.Name wksBlattNeu.Name Then
Set rngBereich = wksBlatt.Cells.Find(What:=strFinden, LookIn:=xlValues, LookAt:=xlPart)
If Not rngBereich Is Nothing Then
strGefunden = rngBereich.Address
Do
lngZeile = rngBereich.Row
intSpalte = rngBereich.Column
lngLetzteZeile = lngLetzteZeile + 1
wksBlatt.Rows(lngZeile).Copy wksBlattNeu.Rows(lngLetzteZeile)
wksBlattNeu.Hyperlinks.Add Anchor:=wksBlattNeu.Cells(lngLetzteZeile, intSpalte), Address:="", SubAddress:= _
wksBlatt.Name & „!“ & rngBereich.Address, TextToDisplay:=rngBereich.Value
wksBlattNeu.Cells(lngLetzteZeile, intSpalte).AddComment wksBlatt.Name & Chr(10) & rngBereich.Address & Chr(10)
Set rngBereich = wksBlatt.Cells.FindNext(rngBereich)
Loop While rngBereich.Address strGefunden
wksBlattNeu.Columns.AutoFit
End If
End If
Set rngBereich = Nothing
Next

Set wksBlattNeu = Nothing
On Error GoTo 0
Exit Sub

Suche_Anzeige_Error:
MsgBox „Error " & Err.Number & " (“ & Err.Description & „)“
Set wksBlattNeu = Nothing
Set rngBereich = Nothing
End Sub

Das Makro funktioniert auch super! ich möchte aber jetzt, dass bei den Suchergebnissen immer die erste Zeile, also die Überschrift, der ursprünglichen Tabelle angezeigt wird.

Kenne mich selber leider mit VBA nicht wirklich aus…kann jemand helfen?

Danke

Hi Steffi,

ich habe auf der Suche nach einem makro, dass in meiner
Tabelle ein Makro startet folgendes gefunden

das ist aber kein Makro was in deiner Tabelle ein Makro startet.

Und benutze bitt beim Posten von Code den Pre-Tga, wird unterhalb des Eingabefensters erklärt, dann kann man Code viel besser lesen.

Das Makro funktioniert auch super!

Biste da sicher? Die Ergebnisse werden zwar sauber Zeilenweise untereinander geschrieben, aber in die Spalten wo die Fundstelle war, ist das so gewünscht?
Übersichtlich ist das nicht.

ich möchte aber jetzt, dass
bei den Suchergebnissen immer die erste Zeile, also die
Überschrift, der ursprünglichen Tabelle angezeigt wird.

Normalerweise hat die erste Zeile meist mehrere Überschriftszellen, also wie/wo genau soll was genau angezeigt werden?

Achja, wenn du viele Blätter mit sehr viel Inhalt hast (XL2007 mit ner Million Zeilen) dann ändere
Dim intSpalte As Integer
ab in:
Dim lngSpalte As Long
dann ist der Code schneller, abgesehen davon daß man Bytes spart im Arbeitsspeicher.

Ist deine Anfrage so gemeint (die Überschrift der Spalte der Fundstelle erscheint im Kommentar):

Option Explicit
'
Public Sub Suche\_Anzeige()
Dim rngBereich As Range
Dim strGefunden As String
Dim strFinden As String
Dim wksBlatt As Worksheet
Dim wksBlattNeu As Worksheet
Dim lngLetzteZeile As Long
Dim lngZeile As Long
Dim intSpalte As Integer
On Error GoTo Suche\_Anzeige\_Error
Application.ScreenUpdating = False
For Each wksBlatt In ThisWorkbook.Sheets
 If wksBlatt.Name Like "Gefunden\_\*" Then
 Application.DisplayAlerts = False
 wksBlatt.Delete
 Application.DisplayAlerts = True
 End If
Next wksBlatt
strFinden = InputBox("Geben sie das gesuchte Wort oder" & vbLf & \_
 "den gesuchten Wortteil ein:", "Suchen", "Suchbegriff")
If strFinden = "" Then Exit Sub
Set wksBlattNeu = Worksheets.Add(before:=Sheets(1))
wksBlattNeu.Name = "Gefunden\_" & Format(Now, "dd\_mm\_yy\_hh\_mm\_ss")
For Each wksBlatt In ThisWorkbook.Sheets
 If wksBlatt.Name wksBlattNeu.Name Then
 Set rngBereich = wksBlatt.Cells.Find(What:=strFinden, LookIn:=xlValues, LookAt:=xlPart)
 If Not rngBereich Is Nothing Then
 strGefunden = rngBereich.Address
 Do
 lngZeile = rngBereich.Row
 intSpalte = rngBereich.Column
 lngLetzteZeile = lngLetzteZeile + 1
 wksBlatt.Rows(lngZeile).Copy wksBlattNeu.Rows(lngLetzteZeile)
 wksBlattNeu.Hyperlinks.Add Anchor:=wksBlattNeu.Cells(lngLetzteZeile, intSpalte), Address:="", SubAddress:= \_
 wksBlatt.Name & "!" & rngBereich.Address, TextToDisplay:=rngBereich.Value
 wksBlattNeu.Cells(lngLetzteZeile, intSpalte).AddComment wksBlatt.Name & Chr(10) & rngBereich.Address & Chr(10) \_
 & wksBlatt.Cells(1, intSpalte)
 Set rngBereich = wksBlatt.Cells.FindNext(rngBereich)
 Loop While rngBereich.Address strGefunden
 End If
 End If
Next wksBlatt
wksBlattNeu.Columns.AutoFit
Suche\_Anzeige\_Error:
 Application.ScreenUpdating = True
 If Err.Number 0 Then MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
 Set wksBlattNeu = Nothing
 Set rngBereich = Nothing
End Sub

Gruß
Reinhard

Hallo Reinhard

das Makro wird über einen command button gestartet…
Wenn ich den Button drücke und einen Suchbegriff eingebe, dann wird ein neues Tabellenblatt aufgemacht, in das er die Zeilen kopiert nicht aber ausschneidet. Und ich find das schon recht übersichtlich…es ist ja getrennt vo der anderen Liste aufgeschrieben.

Mit Überschrift meine ich Zeile 1 und 2. Sorry daran habe ich nicht gedacht.

Gut beim nächsten mal werde ich den Code anders posten. Danke für den Hinweis

Hi Steffi,

Wenn ich den Button drücke und einen Suchbegriff eingebe, dann
wird ein neues Tabellenblatt aufgemacht, in das er die Zeilen
kopiert nicht aber ausschneidet. Und ich find das schon recht
übersichtlich…es ist ja getrennt vo der anderen Liste
aufgeschrieben.

wir missverstehen uns, wenn du den Code laufen läßt und eine Fundstelle ist in Spalte A und eine andere Fundstelle in Spalte IV, so hast du im Ergebnisblatt einen Eintrag in A 1 und einen Eintrag in IV 2, und das halte ich für extrem unübersichtlich.

In meiner Nachfrage war/ist das Angebot versteckt, den Code umzuschreiben, sodaß dann im Ergebnisblatt die Fundstellenlinks in A 1 und A 2 stehen.

Mit Überschrift meine ich Zeile 1 und 2. Sorry daran habe ich
nicht gedacht.

*grmpfl* Die Zeilen 1 und 2 haben zusammen 512 oder auch 32768 Zellen, sollen die alle in den Kommentar mitreingeschrieben werden?

Hast du meinen Code überhaupt mal getestet!? Und, gibt’s ein Feedback was nicht klappt!?

Gruß
Reinhard