PDA

Vollständige Version anzeigen : Makro-Suchfunktion


rapoport
16.03.2009, 10:59
Hallo liebes Forum,

in einem Excel-Dokument (Version 2002) müssen die User später Bedienungsanleitungen (BAs) per Freitext-Suche (über Bezeichnung oder Ident-Nr) herausfinden können.
Die (zu durchsuchenden) Quelldaten liegen in einem als Text formatierten Sheet "BA" mit den Spalten Bezeichnung, IdentNr und Version, vor.
Hierzu habe ich ein funktionierendes Makro aus einer früher erstellten Arbeitsmappe übernommen, nur habe ich jetzt ein Problem, dass die Suchergebnisse jeweils zweifach vorkommen. Grober Ablauf des Makros: Sheet "BA" wird nach dem eingegebenen Textbaustein in der Suchmaske durchsucht und in einem neu erstellten Sheet "Gefunden" werden die Treffer gelistet (nur jetzt eben immer doppelt statt einfach).
Nachfolgend der 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", "D - ****")

Application.StatusBar = ""

If strFinden = "" Then Exit Sub

Set wksBlattNeu = Worksheets.Add(before:=Sheets(1))
wksBlattNeu.Name = "Gefunden"

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


Worksheets("Gefunden").Hyperlinks.Delete
Worksheets("BA").Hyperlinks.Delete

Application.StatusBar = "Suchergebnis"

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

Wie gesagt, der gleiche Code (nur mit angepassten Namen der jeweiligen Sheets) funktioniert in einer anderen Arbeitsmappe einwandfrei.

Jemand einen Tipp oder eine Idee?
Besten Dank für jede Hilfe!!!

Nepumuk
16.03.2009, 11:51
Hallo Michael,

setz mal einen Haltepunkt auf die Zeile:

Loop While rngBereich.Address <> strGefunden

und schau nach, wo die gefundene Zelle ist. Eventuell sind deine Texte zweimal in der Mappe. Ansonsten kann ich das nicht nachvollziehen.

rapoport
16.03.2009, 12:21
Hallo Nepumuk,

Danke für Deine Antwort. Beim Setzen des Haltepunkts hat das Makro gerade den Suchbegriff gefunden und 1x gelistet. Lasse ich den Code dann weiterlaufen, läuft das Makro noch ein mal den Bereich ab Do bis Loop While durch und listet entsprechend noch einmal die Suchergebnisse....
Mir erschließt sich auch nicht, wieso es der Fall ist.

Evtl. muss man noch was anderes beachten...aber was??

Nepumuk
16.03.2009, 12:37
Hallo Michael,

was steht beim 1. Stop denn in strGefunden und in rngBereich.Address ? (Ausdruck markieren und Shift+F9 drücken)

rapoport
16.03.2009, 12:58
Hallo,
nachdem ich das ganze Dokument einfach in ein neues, leeres Dokument kopiert habe, funktioniert die Suche wieder problemlos und listet die Ergebnisse jeweils 1x, wie gewünscht. Aber keine Ahnung an welchem Bug es jetzt lag....

Besten Dank für Deine Mühe.

P.S. Ich habe noch eine weiterführende Frage zur "Verfeierung" der Suchfunktion, aber da mach ich am besten wohl einen neuen Thread auf.