einzelne Wörter herausfiltern - Excel

Question

Hallo zusammen

ich arbeite mit untenstehendem Makro, um von meiner Excel-Tabelle bestimmte Daten in ein separates Tabellenblatt herauszufiltern. Es handelt sich bei den Datensätzen jeweils um ganze Sätze. Jetzt möchte ich aber nicht immer die ganzen Datensätze kopiert haben, sondern nur einzelne Wörter, beispielsweise mit der Buchstabenfolge "ck". Kann mir jemand helfen, das Makro entsprechend abzuändern?

Vielen herzlichen Dank!
Suki




Sub suchen_kopieren()

Application.ScreenUpdating = False
Dim Begriff As String, gefunden As Variant, firstAddress As Variant, _
Zeile As Long
Begriff = InputBox("suche nach:", "Suchbegriff")
If Begriff = "" Then Exit Sub
With Sheets("Tabelle1").Cells
Set gefunden = .Find(Begriff, LookIn:=xlValues)
If Not gefunden Is Nothing Then
firstAddress = gefunden.Address
Do
Zeile = gefunden.Row
Rows(Zeile).Copy
Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial
Set gefunden = .FindNext(gefunden)
Loop While Not gefunden Is Nothing And gefunden.Address <> firstAddress
End If
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Answer 1

Hallo Suki,

wenn ich Dich richtig verstanden habe müsste es so funktionieren.

Option Explicit

Sub suchen_kopieren()

Application.ScreenUpdating = False
Dim Begriff As String, gefunden As Variant, firstAddress As Variant
Begriff = InputBox("suche nach:", "Suchbegriff")
If Begriff = "" Then Exit Sub
With Sheets("Tabelle1").Cells
Set gefunden = .Find(Begriff, LookIn:=xlValues)
If Not gefunden Is Nothing Then
firstAddress = gefunden.Address
Do
gefunden.Copy
Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial
Set gefunden = .FindNext(gefunden)
Loop While Not gefunden Is Nothing And gefunden.Address <> firstAddress
End If
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Gruss
Rainer

Answer 2

Vielen Dank für die schnelle Antwort!

Hm, ich habe es probiert, es kopiert aber nicht nur die einzelnen Wörter, sondern immer die ganzen Sätze.

Vielleicht nochmals zur Präzision:

A1: "Er liegt auf der Straße."
A2: "Ich bin müde."
A3: "Gruß und Kuss."

Jetzt hätte ich gerne, dass mir im zweiten Tabellenblatt lediglich einzelne Wörter angezeigt werden, z.B. wenn ich sage, "suche nach "ß", dass mir dann einfach dies angegeben wird:
- Straße
- Gruß

Den Rest des Satzes möchte ich nicht exportieren.

Wäre super, wenn es dazu eine Lösung gäbe! Besten Dank schon im Voraus!

Answer 3

Hallo Suki,

offensichtlich habe ich Deine Frage falsch verstanden.

Ich nahm an Du sprichst von Datensätzen, die sich über mehrere Spalten erstrecken und nur das Datenfeld welches das Suchkriterium enthält soll zurück gegeben werden.

Für das heraus picken eines einzelnen Wortes aus einem Satz, welcher in einer Zelle steht, fällt mir im Moment leider keine Lösung ein.

Hier sind die VBA-Spezialisten gefragt, zu denen ich leider nicht gehöre.

Gruss
Rainer

Answer 4

Hallo Suki,

nachfolgendes Makro sucht im aktiven Tabellenblatt nach dem eingegebenen Buchstaben und kopiert das Wort, in dem der Buchstabe vorkommt, in das Tabellenblatt "Tabelle2".

Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.

Option Explicit

Sub suchen_kopieren()

Application.ScreenUpdating = False
Dim Begriff As String, gefunden As Variant, firstAddress As Variant, _
Zeile As Long

Dim strSuchwort() As String
Dim iSuchwort As Integer
Dim iWortlänge As Integer

Begriff = InputBox("suche nach:", "Suchbegriff")
If Begriff = "" Then Exit Sub
With Sheets("Tabelle1").Cells
Set gefunden = .Find(Begriff, LookIn:=xlValues)
If Not gefunden Is Nothing Then
firstAddress = gefunden.Address
Do
'Text aus der gefundenen Zelle in einzelne Wörter aufsplitten
strSuchwort = Split(Range(gefunden.Address), " ")
'Alle Wörter der gefundenen Zelle durchsuchen
For iSuchwort = 0 To UBound(strSuchwort)
'Abgefragtes Wort Buchstabenweise durchsuchen
For iWortlänge = 1 To Len(strSuchwort(iSuchwort))
'Wenn abgefragter Buchstabe mit dem Suchbegriff übereinstimmt, Wort kopieren
If Mid(strSuchwort(iSuchwort), iWortlänge, 1) = Begriff Then
Sheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = _
strSuchwort(iSuchwort)
End If
Next
Next
Set gefunden = .FindNext(gefunden)
Loop While Not gefunden Is Nothing And gefunden.Address <> firstAddress
End If
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub



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

Answer 5

Lieber Oliver,

wow, vielen vielen herzlichen Dank!!! Das ist genau das, was ich brauche! Das erleichtert mir meine Arbeit ungemein, zumal es sich um rund 2000 Datensätze handelt, in denen ich die entsprechenden Daten von Hand hätte rauskopieren müssen!
Vielen vielen Dank also für deine Mühe, ich weiss sie sehr zu schätzen!

Liebe Grüsse,
Suki