Excel: Arbeitsmappe durchsuchen - Ergebnisliste
22.07.2014 15:39:55
fcs
Hallo Netu,
hier der Code eines entsprechenden Makros, den du im VBA-Editor in einem allgemeinen Modul einfügen musst. Die Werte der von mir kommentierten Variablen musst du noch an deine Bedürfnisse anpassen.
Gruß
Franz
'Makro in einem allgemeinen Modul
Option Explicit
Private varFind As Variant
Sub Suche_in_Mappe()
Dim wksErgebnis As Worksheet, ZeileErgebnis As Long
Dim strErgebnis As String, ZeileTitelErgebnis As Long
Dim bolValueFormatOnly As Boolean, bolGefunden As Boolean, _
bolLoeschenAlt As Boolean
Dim wks As Worksheet, rngSuchbereich As Range
Dim rngFind As Range, lngFind As Long, str1stAdr As String
strErgebnis = "Suchergebnis" 'Name des Tabellenblatts in das Ergebnisse _
kopiert werden - ggf. anpassen
ZeileTitelErgebnis = 1 'Zeile unterhalb der die Ergebnisse eingefügt werden _
sollen - ggf. anpassen
bolValueFormatOnly = False 'auf True ändern, wenn nur Formate und Werte _
kopiert werden sollen
bolLoeschenAlt = True 'auf False ändern, wenn Werte der vorherigen Suche _
nicht gelöscht werden sollen
'Suchbegriff eingeben
varFind = InputBox("Suchbegriff (keinen Leertext suchen!)" & vbLf _
& "Platzhalterzeichen Sternchen (*) oder Fragezeichen (?) " _
& "können im Suchbegriff verwendet werden", _
"Suche in Arbeitsmappe", Default:=varFind)
If varFind = "" Then Exit Sub
'Ergebnisblatt vorbereiten
Set wksErgebnis = ActiveWorkbook.Worksheets(strErgebnis)
With wksErgebnis
'letzte benutzte Zeile im Ergebnisnblatt ermitteln
Set rngFind = .Cells.Find(What:="*", After:=.Range("A1"), LookIn:=xlFormulas, _
lookat:=xlWhole, Searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngFind Is Nothing Then
ZeileErgebnis = 0
Else
ZeileErgebnis = rngFind.Row
End If
If bolLoeschenAlt = True Then
If ZeileErgebnis > ZeileTitelErgebnis Then
'Zeilen mit Altdaten löschen
.Range(.Rows(ZeileTitelErgebnis + 1), .Rows(ZeileErgebnis)).Clear
End If
ZeileErgebnis = ZeileTitelErgebnis
End If
End With
'Tabellenblätter abarbeiten
For Each wks In ActiveWorkbook.Worksheets
Select Case wks.Name
Case strErgebnis, "Tabelle XYZ" 'Tabellenname(n) ggf. anpassen/ergänzen
'in diesen Tabellenblättern nicht suchen
Case Else
With wks
'Variablen zurücksetzen
Set rngFind = Nothing
str1stAdr = ""
lngFind = 0
'zu durchsuchender Zellbereich
Set rngSuchbereich = .Cells
'Suchbegriff suchen
Set rngFind = rngSuchbereich.Find(What:=varFind, LookIn:=xlValues, _
lookat:=xlWhole, Searchorder:=xlByRows, MatchCase:=False)
If rngFind Is Nothing Then
'Suchbegriff im Blatt nicht vorhanden
Else
'Zelladresse der 1. Fundstelle merken
str1stAdr = rngFind.Address
Do
bolGefunden = True
'Zeile der gefundenen Zelle prüfen
Select Case rngFind.Row
Case 1, lngFind
'Suchbegriff in Zeile 1 oder mehrfach in Zeile
'Case-Werte ggf. anpassen
Case Else
'Zeile der gefundenen Zelle merken
lngFind = rngFind.Row
'Zähler für Zielzeile erhöhen
ZeileErgebnis = ZeileErgebnis + 1
If bolValueFormatOnly = True Then
'Zeile mit Fundstelle kopieren - nur Werte und Formate
.Rows(lngFind).Copy
wksErgebnis.Rows(ZeileErgebnis).PasteSpecial Paste:=xlPasteFormats
wksErgebnis.Rows(ZeileErgebnis).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Else
'Zeile mit Fundstelle kopieren - ggf. inkl. Formeln etc.
.Rows(lngFind).Copy wksErgebnis.Rows(ZeileErgebnis)
End If
End Select
'Nächste Fundstelle suchen
Set rngFind = rngSuchbereich.FindNext(After:=rngFind)
Loop Until rngFind.Address = str1stAdr
End If
End With
End Select
Next
If bolGefunden = False Then
MsgBox "Keine Treffer für Suchbegriff """ & varFind & """ gefunden", _
vbOKOnly, "Suche in Arbeitsmappe"
Else
wksErgebnis.Activate
End If
End Sub
