Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

suche funktion über eine Makroprogramm





Frage

Ich würde gerne eine Suchfunktion über ein makro programmieren so das mir das Ergebniss eventuell in enem eigenem bericht aufgelistet wird. Fürs erste würde ich aber schon eine Suchefunkt über ein Makro erstellen können. Habe leider überhaupt kein Plan... ... Hilfe

Antwort 1 von Guenter

Hallo,

hast Du schon mal versucht über die Makroaufzeichnung weiter zu kommen?
Also Makroaufzeichnung einschalten und dann die Suche manuell ausführen, Makroaufzeichnung abschalten.

Dann hast du in der Entwicklungsumgebung das fertige Makro.

Gruß
Günter

Antwort 2 von rekom

Hallo Günter,

ja das habe ich versucht läuft aber nicht. Meine Vorstellung sollte dann ein fenster aufgehen in dem ich den Suchbegriff schreiben kann und dann bestätige....

Aber trotzdem vielen Dank

Antwort 3 von Annan

Hallo rekom,

gebe folgenden Code in ein Klassenmodul u. weise ihn einem CommandButton zu:

Sub Suchbegriff()
´Sucht in der gesamten Mappe nach einem Begriff und kopiert die
´gefundene Zeile in eine Ergebnistabelle
Dim sResultName As String
Dim sWks As Worksheet, tarWks As Worksheet
Dim sRng As Range
Dim sAddress As String
Dim Qe As Integer, i As Integer
Dim fString As Integer, fUnit As Integer
´Suchbegriff
Dim sFind As Variant
Dim cr As Long
fString = 0
fUnit = 0
´Name_der_Zieltabelle
´Bitte Anpassen !!!!
sResultName = "Suchergebnis"
For i = 1 To Worksheets.Count
If Worksheets(i).Name = sResultName Then
Qe = MsgBox("Ergebnistabelle existiert schon!" & vbCrLf & _
"Tabelle löschen ?", vbCritical + vbYesNo, "Wie weiter ... ?")
If Qe = vbNo Then
MsgBox "Makro wird abgebrochen"
Exit Sub
End If
Application.DisplayAlerts = False
Worksheets(i).Delete
Application.DisplayAlerts = True
Exit For
End If
Next i
sFind = InputBox("Bitte Suchbegriff eingeben:", "Suche nach", "Hier Begriff eingeben !")
If sFind = "" Or sFind = "Hier Begriff eingeben !" Then
Qe = MsgBox("Kein Suchbegriff angegeben", vbInformation + vbOKOnly, "Abbruch")
Exit Sub
End If
Worksheets.Add.Name = sResultName
Set tarWks = Worksheets(sResultName)
With tarWks
.Range("A1") = "eingegebenes Suchkriterium:"
.Range("B1") = sFind
.Range("A3") = "In welchen Tabellen gefunden:"
End With
cr = 4
For Each sWks In Worksheets
If sWks.Name <> tarWks.Name Then
Set sRng = sWks.Cells.Find(What:=sFind, _
LookAt:=xlPart, LookIn:=xlFormulas)
If Not sRng Is Nothing Then
sAddress = sRng.Address
Do
Application.GoTo sRng, True
tarWks.Cells(cr, 1) = sWks.Name
tarWks.Cells(cr, 2) = sRng.Offset(0, 1).Value
cr = cr + 1
fString = fString + 1
fUnit = fUnit + sRng.Offset(0, 1).Value
Set sRng = sWks.Cells.FindNext(after:=ActiveCell)
If sRng.Address = sAddress Then Exit Do
Loop
End If
End If
NextStart:
Next sWks
Qe = MsgBox("Suchbegriff: " & sFind & " wurde " & fString & " mal gefunden.", vbInformation + vbOKOnly, "Suche abgeschlossen")
Sheets("Tabelle1").Select
Sheets("Tabelle1").Range("A1").Select
Sheets("Tabelle2").Select
Sheets("Tabelle2").Range("A1").Select
Sheets("Tabelle3").Select
Sheets("Tabelle3").Range("A1").Select
Sheets("Suchergebnis").Select
End Sub

Ich habe 3 Tabellenblätter in meiner Testmappe !
Die Tabellenblätter habe ich mit Tabelle1,Tabelle2,Tabelle3 bezeichnet ! Bei Bedarf musst du diese entsprechend im Code umschreiben.
Ansonsten ist die Funktion, nachdem du den Code einer Schaltfläche zugewiesen hast, selbsterklärend !

MfG
Annan

Antwort 4 von coros

Moin an alle,

da habe ich auch noch eine Variante, so wie ich sie in einigen meiner Exceldateien einsetze. Allerdings verwende ich das Makro ohne die Funktion, dass die gefundenen Begriffe in einem neuen Blatt aufgefürt werden. Das Makro habe ich aber dahingehend abgeändert. Kopiere nachfolgendes Makro in ein StandardModul.

Sub Suchen()
Dim Suchebegriff As String, Bereich As Range, ErsteAddresse As String, _
gefunden() As String, Index1 As Integer, Index2 As Integer, Text As String
Text = "Die nächste Übereinstimmung anzeigen?"
Do
Suchebegriff = InputBox("Mindestens die 3 ersten Buchstaben des" & _
" kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen")
If Suchebegriff = "" Or Len(Suchebegriff) = 0 Then Exit Sub
Loop Until Len(Suchebegriff) > 2
Set Bereich = Range("A1:IV65536").Find(what:=Suchebegriff, lookat:=xlPart, _
LookIn:=xlValues, MatchCase:=False)
If Bereich Is Nothing Then
Beep
MsgBox "Suchbegriff wurde nicht gefunden! Es ist aber nicht 100% sicher, " & _
"dass der gesuchte Begriff sich nicht in der Tabelle befindet. Überprüfen " & _
"Sie daher bitte nochmal die Schreibweise und geben den Suchbegriff erneut " & _
"ein, oder suchen Sie den Begriff manuell in der Tabelle."
Else
Application.ScreenUpdating = False
Altes_Blatt = ActiveSheet.Name
Worksheets.Add
Neues_Blatt = ActiveSheet.Name
Sheets(Altes_Blatt).Activate
Application.ScreenUpdating = True
ErsteAddresse = Bereich.Address
Do
Index1 = Index1 + 1
ReDim Preserve gefunden(1 To Index1)
gefunden(Index1) = Bereich.Address
Set Bereich = Range("A1:IV65536").FindNext(Bereich)
Loop While Not Bereich Is Nothing And Bereich.Address <> ErsteAddresse
Do
Index2 = Index2 + 1
If Index2 = Index1 Then
Text = ""
End If
ZeileTab2 = Sheets(Neues_Blatt).Range("A65536").End(xlUp).Offset(1, 0).Row
ZeileTab1 = Sheets(Altes_Blatt).Range(gefunden(Index2)).Row
Rows(ZeileTab1).Copy Sheets(Neues_Blatt).Cells(ZeileTab2, 1)
Range(gefunden(Index2)).Select
ActiveWindow.ScrollRow = Selection.Row
ActiveWindow.ScrollColumn = Selection.Column
If MsgBox(CStr(Index2) & ". von " & CStr(Index1) & " gefundenen " & _
"Übereinstimmungen des Suchbegriffes." & vbNewLine & Text, schalter, _
"Anzeige") = 7 Then Exit Do
If Index2 = Index1 Then Exit Do
Loop
Sheets(Neues_Blatt).Activate
End If
End Sub


Bei dem Makro wird zum Anfang ein Eingabefenster geöffnet, in dem mindestens die ersten drei Buchstaben des Suchbegriffes eingegeben werden müssen. Danach werden die gefundenen Einträge angesprungen, damit man den Begriff optisch sehen kann. Außerdem wird die komplette Zeile des Suchbegriffes dann in ein separates Tabellenblatt, welches automatisch erstellt wird, kopiert. Wenn Du nicht möchtest, dass die komplette Zeile kopiert wird, dann musst Du in dem Makro die Zeilen

ZeileTab1 = Sheets(Altes_Blatt).Range(gefunden(Index2)).Row
Rows(ZeileTab1).Copy Sheets(Neues_Blatt).Cells(ZeileTab2, 1)

löschen und durch die Zeile

Range(gefunden(Index2)).Copy Sheets(Neues_Blatt).Cells(ZeileTab2, 1)

ersetzen.

Ich hoffe, Du kommst klar. Bei Fragen melde Dich wieder.

MfG,
coros
Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein
Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.

Antwort 5 von rekom

Vielen Dank für Eure Mühe,

werde beide Versionen am Wochende testen.

aber wirklich vielen Dank schon in voraus...

Antwort 6 von Boerrt

Hallo Jungs,

Ich benötige genau diese Suchfunktion die coros gepostet hat, nur mit dem Unterschied, dass ich einfach nur an die Stelle springen möchte, wo der gesuchte Wert ist (also kein neues Sheet mit den Ergebnissen) und dass ich alle (sind ca. 5 Tabellenblätter) Tabellenblätter durchsuchen möchte. Komme hier einfach nicht weiter, bin aber leider auch noch VBA Anfänger. Ich habe es auch schon mit Dim wsTabelle as Worksheet , For Each wsTabelle In ThisWorkbook.Sheets und Next wsTabelle versucht, doch das klappt alles irgendwie nicht richtig. Könnt ihr mir weiterhelfen?

Hier mal die Sachen, die ich probiert habe und die nicht funktioniert haben:

Sub Suchen()
Dim Suchebegriff As String, Bereich As Range, ErsteAddresse As String, _
gefunden() As String, Index1 As Integer, Index2 As Integer, Text As String
Dim wsTabelle As Worksheet

Text = "Die nächste Übereinstimmung anzeigen?"
Do
Suchebegriff = InputBox("Mindestens die 3 ersten Buchstaben des" & _
" kompletten Suchbegriff eingeben. Groß-/Kleinschreibung ist egal.", "Suchen")
If Suchebegriff = "" Or Len(Suchebegriff) = 0 Then Exit Sub
Loop Until Len(Suchebegriff) > 2

For Each wsTabelle In ThisWorkbook.Sheets

Set Bereich = Range("A1:IV65536").Find(what:=Suchebegriff, lookat:=xlPart, _
LookIn:=xlValues, MatchCase:=False)
If Bereich Is Nothing Then
Beep
MsgBox "Suchbegriff wurde nicht gefunden74"
GoTo Ende
Else
Application.ScreenUpdating = True
ErsteAddresse = Bereich.Address
´Do
´Index1 = Index1 + 1
´ReDim Preserve gefunden(1 To Index1)
gefunden(Index1) = Bereich.Address
End If
Ende:
Next wsTabelle
´Set Bereich = Range("A1:IV65536").FindNext(Bereich)
´If Bereich Is Nothing Then GoTo Ende

´Loop While Bereich.Address <> ErsteAddresse
´Do
´Index2 = Index2 + 1
´If Index2 = Index1 Then
´Text = ""
´End If

Range(gefunden(Index2)).Select
ActiveWindow.ScrollRow = Selection.Row
ActiveWindow.ScrollColumn = Selection.Column
´If MsgBox(CStr(Index2) & ". von " & CStr(Index1) & " gefundenen " & _
´"Übereinstimmungen des Suchbegriffes." & vbNewLine & Text, schalter, _
´"Anzeige") = 7 Then Exit Do
´If Index2 = Index1 Then Exit Do
´Loop
´End If


End Sub
----------------------------------------------


Das hier ist der zweite Code, den ich ausprobiert habe:

Dieser einfache Code macht eigentlich schon das nötigste, was ich brauche, er funktioniert aber nur in meinem gerade aktiven Tabellenblatt. Natürlich wäre so eine Auflistung, die mir aufzählt wieviele Ergebnisse gefunden wurden auch ganz schön.

Option Explicit
Private Sub Suchen7474()




Dim wsTabelle As Worksheet
Dim strSuchBegriff As String
Dim rngSuchErgebnis As Range








strSuchBegriff = InputBox("Bitte Suchbegriff eingeben:", "Alle geöffneten Exceldateien durchsuchen")


If strSuchBegriff = "" Then Exit Sub


For Each wsTabelle In ThisWorkbook.Sheets


Set rngSuchErgebnis = wsTabelle.Cells.Find(strSuchBegriff)
If Not rngSuchErgebnis Is Nothing Then

If rngSuchErgebnis.Select = "" Then

´ Hier bekomme ich den Fehler Die Select Eigenschaft des Range Objekts kann nicht zugeordnet
´werden, wenn ich in einem anderen Tabellenblatt als dem aktiven, in dem ich mich gerade befinde einen Wert suche
Exit Sub
Else

rngSuchErgebnis.Select

End If

End If

Next

End Sub


Wo liegt mein Problem? Was kann man machen?
Gruß, und Danke für die Hilfe

Antwort 7 von Boerrt

Hallo,

Habe eine Lösung für dieses Makro im Thread http://www.office-loesung.de/ftopic70052_75_0_asc.php
gefunden.

Leider gibt es noch ein Problem:
Ich hab in meiner Tabelle verbundene Zellen, bei denen mehrere Zeilen miteinander verbunden sind (Bsp.: Zelle A18-20:C18-20)
Wenn ich nach Werten in diesen Zellen suche, bekomme ich folgende Fehlermeldung:
"Objektvariable oder With Blockvariable nicht festgelegt"
Der Fehler ist in der Zeile

Loop While Not rngSuchErgebnis Is Nothing And rngSuchErgebnis.Address <> strErsteAdresse  




Kann man da was machen? Vielen Dank für eure Hilfe

Antwort 8 von Boerrt

Okay, das Problem habe ich lösen können.

Man muss or den Loop noch
If rngSuchErgebnis Is Nothing Then Exit Do 

einfügen, dann klappt alles

Gruß,Boerrt

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: